• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

togglebutton ilk kez kullanıyorum

Katılım
13 Mayıs 2005
Mesajlar
761
Excel Vers. ve Dili
2010 Türkçe
İlk defa togglebutton kullanıyorum bi örneğe bakmıştım ama sürekli hata veriyor. neye dikkat etmek gerekiyor.
ilk komuta bi makro diğer komuta başka makro ilave ettim. normalde bu makrolar çalışıyor ama butonda hata verdi.

Kod:
Private Sub ToggleButton1_Click()
If ToggleButton1.Value = 0 Then
  ToggleButton1.Caption = "49/ A-B OTOMATİK"
 
    sor = MsgBox("Ağı A-B ve Sorumluluk primleri manuel hesaplansınmı? Eğer EVET derseniz otomatik hesap kapanacaktır ve el ile Puantaja girmeniz gerekecektir..!!!", 20, "UYARI")
    If sor = vbNo Then Exit Sub
    
    Application.EnableEvents = False
    
    Sheets("Puantaj").Select
    Range("L6").Select
    ActiveSheet.Unprotect "61"
'--------------------------------------------------------
'Hücre korumasını kaldırma
    Range("BF6:BH155").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
'--------------------------------------------------------
    Application.EnableEvents = True

    ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Range("L6").Select
    Sheets("Sabitler").Select
 
 
'  X = False
  Else
  ToggleButton1.Caption = "49/ A-B OTOMATİK"

sor = MsgBox("Ağı A-B ve Sorumluluk primleri Fiili göreve göre hesaplansınmı? Eğer EVET derseniz otomatik hesaba geçecekti.!!!", 20, "UYARI")
If sor = vbNo Then Exit Sub
    
    Application.EnableEvents = False

Sheets("Puantaj").Select
Range("L6").Select
ActiveSheet.Unprotect "61"

'-------------------------------------------------------
'49 a ve b 50 sorumluluk formül girme
    Range("BF6").Select
    ActiveCell.FormulaR1C1 = _
        "=IF((IFERROR(VLOOKUP(RC11,'Personel Listesi'!R3C3:R152C24,13,FALSE),""""))=""X"",RC71,(IF((IFERROR((VLOOKUP(RC13,'Fiili Görevler'!R2C2:R100C6,2,FALSE)),0))=Kodlar!R2C15,RC45,0)))+(IFERROR((VLOOKUP(RC11,Ekstra!R4C3:R18C17,12,FALSE)),0))"
    Range("BG6").Select
    ActiveCell.FormulaR1C1 = _
        "=IF((IFERROR(VLOOKUP(RC11,'Personel Listesi'!R3C3:R152C24,13,FALSE),""""))=""X"",RC72,(IF((IFERROR((VLOOKUP(RC13,'Fiili Görevler'!R2C2:R100C6,2,FALSE)),0))=Kodlar!R3C15,RC45,0)))+(IFERROR((VLOOKUP(RC11,Ekstra!R4C3:R18C17,13,FALSE)),0))"
    Range("BH6").Select
    ActiveCell.FormulaR1C1 = _
        "=IF((IFERROR(VLOOKUP(RC11,'Personel Listesi'!R3C3:R152C24,13,FALSE),""""))=""X"",RC73,(IF((IFERROR((VLOOKUP(RC13,'Fiili Görevler'!R2C2:R100C6,2,FALSE)),0))=Kodlar!R4C15,RC45,0)))+(IFERROR((VLOOKUP(RC11,Ekstra!R4C3:R18C17,13,FALSE)),0))"
    Range("BF6:BH6").Select
    Selection.Copy
    Range("BF7:BF155").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("BF141").Select
    Selection.End(xlUp).Select
    Range("BF6").Select
'--------------------------------------------------------
'Hücre korumasını kaldırma
    Range("BF6:BH155").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
'--------------------------------------------------------
    Application.EnableEvents = True
    
    ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Range("L6").Select
    Sheets("Sabitler").Select
'  X = True
  End If
End Sub
 
Bu kısmı çözdüm artık konu buton çalışması analamında şimdilik kapanmıştır. :) Başka bi isteğim var. Başlık değiştiğinde yazı rengini değiştirebilirmiyim. Olumlu ise mavi olumsuzken kırmızı gibi.
 
Bu şekilde deneyiniz.
Kod:
Private Sub ToggleButton1_Click()
If Me.ToggleButton1 Then
Me.ToggleButton1.Caption = "Olumlu"
Me.ToggleButton1.ForeColor = &HFF0000
Else
Me.ToggleButton1.Caption = "Olumsuz"
Me.ToggleButton1.ForeColor = &HFF&
End If
End Sub
 
Teşekkür ederim.
 
Geri
Üst