Çoklu onay kutusu ekleme yardım?

[cmalgac]

Merhaba,
Yaklaşık 720 satırlık bir çalışma sayfasının tek bir sütununa mesela A2'den A721'e kadar onay kutusu eklemeye çalışıyorum alt alta ve hücrelere düzenli sığacak şekilde ama olmuyor, kopyalayamıyorum kopyalarsam da tıkladığımda hepsi birinci satıra göre aynı anda doluyor ya da boşalıyor. bunun br kısayolu formülü makrosu varsa paylaşabilir misiniz?

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz? Orijinal kodları değiştirmemeye çalışım.

'http://www.mrexcel.com/forum/excel-questions/180887-add-checkboxes-through-visual-basic-applications-code.html
Sub test()
 
    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 ToRow = 2 To LastRow
    'If Not IsEmpty(Cells(ToRow, "D")) Then
    '-
    MyLeft = Cells(ToRow, "A").Left
    MyTop = Cells(ToRow, "A").Top
    MyHeight = Cells(ToRow, "A").Height
    MyWidth = MyHeight = Cells(ToRow, "A").Width
    '-
    ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
    With Selection
    .Caption = ""
    .Value = xlOff
    .LinkedCell = "A" & ToRow
    .Display3DShading = False
    End With
    ' End If
    Next
 
    Application.ScreenUpdating = True
 
End Sub

 

[Emir Hüseyin Çoban]

. . .

İnceleyiniz.
50 satırlıktır.
Kodlarda belirttiğim alanı değiştirerek satır sayısını arttırabilirsiniz.
721 yapınca yaklaşık 7-8 sn sürüyor çalışması.

. . .

 

[omerceri]

Kendi satır ve sütun boyutlarına göre ayarlarsınız.

Sub Makro1()
 A = 14.4
 For İ = 1 To 100
    Worksheets(3).OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=180, Top:=A, Width:=60, Height:=14.4). _
        Select
        A = A + 14.4
        Next
End Sub

 

[Necdet]

Merhaba,

Yine orijinal kodlarda pek bir değişiklik yapmadan, sadece seçilen alanda onay kutusu ekler.

Önce alan seçilecek sonra kodlar çalıştırılacak, sanırım bu daha parametrik bir uygulama olacaktır.

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

 

[cmalgac]

Merhaba,

Yine orijinal kodlarda pek bir değişiklik yapmadan, sadece seçilen alanda onay kutusu ekler.

Önce alan seçilecek sonra kodlar çalıştırılacak, sanırım bu daha parametrik bir uygulama olacaktır.

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

Çok teşekkürler mükemmel şekilde çalıştı istediğim kadar satırı seçip ekleyebiliyorum

 

[cmalgac]

Çok teşekkürler mükemmel şekilde çalıştı istediğim kadar satırı seçip ekleyebiliyorum

Bir de bir çalışma sayfasının belli bir sütununu yine böyle seçerek o sütunun değerlerine göre büyükten küçüğe tüm sayfayı sıralayacak tek bir buton yapmak istiyorum, mümkün mü?

 

[Necdet]

Bir de bir çalışma sayfasının belli bir sütununu yine böyle seçerek o sütunun değerlerine göre büyükten küçüğe tüm sayfayı sıralayacak tek bir buton yapmak istiyorum, mümkün mü?

Bu ayrı bir konu, bu yüzden ayrı bir konu açınız, konular birbirine karışmamalı.

 

[sukruyilmaz1]

Merhaba,

Yine orijinal kodlarda pek bir değişiklik yapmadan, sadece seçilen alanda onay kutusu ekler.

Önce alan seçilecek sonra kodlar çalıştırılacak, sanırım bu daha parametrik bir uygulama olacaktır.

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

Sayın Üstadım, Uzmanım;

Süper bir kod çalışması. Peki seçtiğimiz alandaki bu checkbox'ları hücrenin enine boyune göre tam ortaya nasıl denk getirebiliriz? Şuan yapılan checkbox hücre boyutu ne olursa olsun hep sola yanaşık duruyor?