Checkbox (onay kutusu) işaretine göre formül kurma

[spacebar]

değerli üstadlarım. onay kutusunun işaretine göre formül kurmak mümkün müdür. yardımlarınız için teşekkürler...

 

[Merhum İdris SERDAR]

.

Dosyanız ekte.

.

 

[spacebar]

İdris Bey merhaba. sayenizde yeni bir şey öğrendim. ellerinize sağlık. çok teşekkür ederim.

 

[spacebar]

üstad tekrar merhaba. formülü benim gönderdiğim ilk dosyaya uyguladığımda çalışmıyor sizin dosyanıza uyguladığımda çalışıyordu. bunun sebebini araştırdım. sizin dosyadaki checkbox lar ile benim ki arasında fark buldum. sizin dosyanızda checkox a sağ tıklayıp denetim biçimlendir/denetim sekmesinde hücre bağlantısı görünüyor. benim dosyamda görünmüyor. bu yüzden düşeyara ile bulamıyor. buraya hücreyi yazdığımda bu sefer yazdığım hücrede doğru/yanlış yazıyor. üstad bu sorunu nasıl aşabilirim. ne yapmam gerekiyor. yardımlarınız için teşekkür ederim.

 

[Merhum İdris SERDAR]

Merhaba.

Ben dosyanızda yer alan checkboxları aşağıda bağlantısını verdiğim dosyanın makrosunu kullanarak yaptım. Çünkü her checkbox'a elle bağlantı vererek zaman haecamak istemedim.

Çoklu Onay kutusu – CheckBox – Excel Gurusu

Sözkonusu kodda yer alan:

.NumberFormat = ";;;" ifadesi hücredeki yazılanı göstermesin diye konulmuştur. Bu nedenle verdiğim dosyada kutunun bağlantı hucresindeki TRUE ve FALSE'ları göremiyorsunuz. Görünür yapmak için bunların dışındaki bir hücreyi kopyalayıp, ilgili alana biçim olarak yapıştıracaksınız.

Bağlantı hücrelerini ya tek tek elle yapacaksınız veya verdiğim kodu kullanacaksınız.

.

 

[spacebar]

üstad benim kodlarım bunlar. sizinki ile karşılaştırıp bulmaya çalışacağım. ilginiz için teşekkürler...

Private Sub Worksheet_Activate()
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        If Cells(i, "A") <> "" Then
            Set Hcr = Cells(i, "H")
            If ChkVrm(Hcr) Then
                Set Check = ActiveSheet.CheckBoxes.Add(Hcr.Left, Hcr.Top, Hcr.Width, Hcr.Height)
                Check.Caption = ""
            End If
        End If
    Next
    End Sub
Function ChkVrm(Hcr)

    ChkVrm = True
    For Each ChkBox In ActiveSheet.CheckBoxes
        If ChkBox.TopLeftCell.Address = Hcr.Address Then
            ChkVrm = False
            Exit Function
        End If
    Next
End Function

 

[spacebar]

İdris Bey üstadım/üstadlarım merhaba. hem öğrenmek istiyorum. hemde çalışmamı tamamlamak istiyorum.çok uğraştım ama yapamadım. yardımcı olursanız sevinirim. benim kodlarım hücre bağlantısını vermiyor. idris beyin kodlarında ise hücre bağlantısını veriyor. Benim çalışmamdaki (aşağıdaki) kodlarla idris beyin hücre bağlantısını veren kodlarını birleştirmek istiyorum. şimdiden teşekkürler..

benim kodlarım :

Private Sub Worksheet_Activate()
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        If Cells(i, "A") <> "" Then
            Set Hcr = Cells(i, "H")
            If ChkVrm(Hcr) Then
                Set Check = ActiveSheet.CheckBoxes.Add(Hcr.Left, Hcr.Top, Hcr.Width, Hcr.Height)
                Check.Caption = ""
            End If
        End If
    Next
    End Sub
Function ChkVrm(Hcr)

    ChkVrm = True
    For Each ChkBox In ActiveSheet.CheckBoxes
        If ChkBox.TopLeftCell.Address = Hcr.Address Then
            ChkVrm = False
            Exit Function
        End If
    Next
End Function

idris beyin kodları :

Sub Onaykutusuekle()
  Dim kutu As CheckBox
  Dim hcr As Range
   Dim hcraln As String
    Dim bagsut As String
   hcraln = InputBox(Prompt:="Onay kutularının yer alacağı alanı belirtiniz. Örnek: A2:A30 gibi...", _
    Title:="ONAY KUTUSU ALANI")
   bagsut = "D"
    With ActiveSheet
    For Each hcr In .Range(hcraln).Cells
      With hcr
        Set kutu = .Parent.CheckBoxes.Add(Top:=.Top, _
          Width:=.Width, Left:=.Left, Height:=.Height)
 
        With kutu
          .LinkedCell = bagsut & hcr.Row
          .Caption = ""
          .Name = "checkbox_" & hcr.Address(0, 0)
        End With
         .NumberFormat = ";;;"
      End With
     Next hcr
  End With
End Sub

burada bagsut olan satırları benim kodlara eklemek istiyorum. sağlıklı günler dilerim...