Çoklu Onay Kutusu Hücre Hizalama Sorunu.

[sukruyilmaz1]

Merhabalar Sayın Uzmanlarım,

Değerli Üstadım @Necdet Bey tarafından aşağıdaki kodlarla seçilen alanda onay kutusu ekleniyor. Eline sağlık Necdet bey'in,

Bu onay kutularını hücrenin boyutuna göre tam ortaya nasıl getirebiliriz?

Sub OnayKutusuEkle()
'http://www.mrexcel.com/forum/excel-questions/180887-add-checkboxes-through-visual-basic-applications-code.html
Dim Rng As Range
Dim ToRow As Long
Dim LastRow As Long
Dim MyLeft As Double
Dim MyTop As Double
Dim MyHeight As Double
Dim MyWidth As Double
'--------------------------
Application.ScreenUpdating = False

LastRow = 720 ' Range("D65536").End(xlUp).Row
For Each Rng In Selection 'ToRow = 2 To LastRow
'If Not IsEmpty(Cells(ToRow, "D")) Then
'-
MyLeft = Rng.Left
MyTop = Rng.Top
MyHeight = Rng.Height
MyWidth = MyHeight = Rng.Width
'-
ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
With Selection
.Caption = ""
.Value = xlOff
.LinkedCell = Rng.Address '"C" & ToRow
.Display3DShading = False
End With
' End If
Next Rng

Application.ScreenUpdating = True
End Sub

 

[kulomer46]

Merhabalar Sayın Uzmanlarım,

Değerli Üstadım @Necdet Bey tarafından aşağıdaki kodlarla seçilen alanda onay kutusu ekleniyor. Eline sağlık Necdet bey'in,

Bu onay kutularını hücrenin boyutuna göre tam ortaya nasıl getirebiliriz?

Merhaba

Sayın @Necdet beyin kodlarında aşağıdaki koyu renkli yerlerdeki değişiklikleri yaptığınızda onay kutuları hücrenin boyutuna göre ortalanmaktadır.

Onay kutuları Excel hücrelerinde ilk yerleştirildiği yerde kalmaktadır.
Hücre boyutlarını değiştirdiğinizde Onay kutusu değişikliğe göre konum almamakta ilk yerleştiği konumda kalmaktadır.

Geniş hücrede hücre ortasına yerleşen onay kutusu, hücreyi daralttığınızda hücre dışına kaymış gibi görüntü vermektedir.
Bu da kullanışlılığı azaltır.

Eğer onay kutularını yerleştirdikten sonra hücre boyutları ile oynamayacaksanız onay kutularını hücrenin boyutuna göre ortalanması işinize yarar.
Aksi takdirde düzensiz ve karmaşık bir durumla karşı karşıya kalabilirsiniz.

Selamlar...


Sub OnayKutusuEkle()
'http://www.mrexcel.com/forum/excel-questions/180887-add-checkboxes-through-visual-basic-applications-code.html
Dim Rng As Range
Dim ToRow As Long
Dim LastRow As Long
Dim MyLeft As Double
Dim MyTop As Double
Dim MyHeight As Double
Dim MyWidth As Double
'--------------------------
Application.ScreenUpdating = False

LastRow = 720 ' Range("D65536").End(xlUp).Row
For Each Rng In Selection 'ToRow = 2 To LastRow
'If Not IsEmpty(Cells(ToRow, "D")) Then
'-
MyLeft = Rng.Left
MyTop = Rng.Top
MyHeight = Rng.Height
MyWidth = Rng.Width / 2
'-
ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
With Selection
.Left = Rng.Left - 8 + (Rng.Width / 2)
.Caption = ""
.Value = xlOff
.LinkedCell = Rng.Address '"C" & ToRow
.Display3DShading = False
End With
' End If
Next Rng

Application.ScreenUpdating = True
End Sub