Farklı Sayfalarda Aynı Anda Onay Kutusu İşaretleme

[owertake]

Herkese merhaba,

A sayfasında 32 adet onay kutusu var ve numaraları var. İşaretlediğim onay kutularını b sayfasındaki belirli bir hücreye sadece isim olarak nasıl kayıt edebilirim?

 

[alicimri]

Class modül ile yapılır, ancak dosya yapınızı görmek lazım. Dosyanızı bir dosya paylaşım sitesine ekleyin linkini paylaşın.

 

[owertake]

Class modül ile yapılır, ancak dosya yapınızı görmek lazım. Dosyanızı bir dosya paylaşım sitesine ekleyin linkini paylaşın.

HastaKayıt.xlsx

docs.google.com

Yapılacak iş kısmında 36 adet onay kutusu var işaretli olanlar aynı şekilde diğer sayfaya geçmesi lazım.

 

[alicimri]

Her iki sayfada da onay kutusu var. Sayfa1 deki onay kutusunu işaretleyince Sayfa2 deki aynı numaralı onay kutusu mu, işaretli hale gelecek.

 

[owertake]

Her iki sayfada da onay kutusu var. Sayfa1 deki onay kutusunu işaretleyince Sayfa2 deki aynı numaralı onay kutusu mu, işaretli hale gelecek.

Evet doğrudur, yada 1. sayfadaki onay kutularının numaraları var. 2. sayfadaki alana o numaraları da yazdırabiliriz.

 

[Biolightant]

Merhaba,

Sayfa1’deki herhangi bir onay kutusuna tıklayınca,
Sayfa2’de aynı metne sahip (Diş No) onay kutusu da otomatik olarak aynı duruma gelir.

Option Explicit

' --- Auto_Open: Sayfa1'deki tüm Form Denetimi CheckBox'lara makro atar
Sub Auto_Open()
    Dim shp As Shape
    For Each shp In ThisWorkbook.Sheets("Sayfa1").Shapes
        If shp.Type = msoFormControl Then
            If shp.FormControlType = xlCheckBox Then
                shp.OnAction = "OnayKutusuTikla"  ' Tıklandığında çalışacak makro
            End If
        End If
    Next shp
End Sub

' --- Tıklanan CheckBox'u yakalar
Sub OnayKutusuTikla()
    Dim clickedShapeName As String
    clickedShapeName = Application.Caller  ' Tıklanan şeklin ismini al

    If Len(clickedShapeName) > 0 Then
        Dim shp As Shape
        Set shp = ActiveSheet.Shapes(clickedShapeName)
        If shp.Type = msoFormControl Then OnayKutusuAynala shp
    End If
End Sub

' --- Sayfa2'deki aynı Text'e sahip CheckBox ile eşler
Public Sub OnayKutusuAynala(OnayKutu As Shape)
    Dim shp As Shape
    Dim sh As Worksheet: Set sh = ThisWorkbook.Sheets("Sayfa2")
    
    For Each shp In sh.Shapes
        If shp.Type = msoFormControl And shp.FormControlType = xlCheckBox Then
            ' Eşleşen metin varsa değeri kopyala
            If LCase(shp.OLEFormat.Object.Text) = LCase(OnayKutu.OLEFormat.Object.Text) Then
                shp.OLEFormat.Object.Value = OnayKutu.OLEFormat.Object.Value
            End If
        End If
    Next shp
End Sub

 

[alicimri]

Aşağıdaki kodları birer kere çalıştırın.
Onay kutularını tıklayarak test edin.
Eğer istediğiniz gibi çalışıyorsa, bu kodları silebilirsiniz.
İstiyorsanız, ("Sayfa1!$J$" & i) yerine , gözden ırak ("Sayfa1!$AZ$" & i) yazabilrsiniz.

'Sayfa2 açıkken çalıştırın
Sub Makro1()
For i = 1 To 32
ActiveSheet.Shapes.Range(i).Select
Selection.LinkedCell = "Sayfa1!$J$" & i
Next
End Sub
'Sayfa1 açıkken çalıştırın
Sub Makro2()
For i = 1 To 32
ActiveSheet.Shapes.Range(i + 2).Select
Selection.LinkedCell = "Sayfa1!$J$" & i
Next
End Sub

 

[Biolightant]

@owertake
Kodlar işe yaradı mı?
Olumlu veya olumsuz dönüş yaparmisiniz.