Problem with autoadjustment in checkboxes linked to cells

[peterghost]

Hi! I would like your help in a little problem that i have. I use this code to add checkboxes to a selected range of cells in excel and link them automatically with each cell (each checkbox is created in the center of its cell). However, if
the width or height of the cells is modified the checkboxes aren't autoadjusted to the new center of the cells. What do i need to add/change?

CODE:
Public Sub Add_ActiveX_Checkboxes()

Dim wks As Worksheet
Dim cell As Range, checkboxCells As Range
Dim objOLE As OLEObject

Set wks = ActiveSheet

Set checkboxCells = Application.Selection
Set checkboxCells = Application.InputBox("Range", "Analysistabs", checkboxCells.Address, Type:=8)

For Each cell In checkboxCells

Set objOLE = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1")

With objOLE
.Width = 12
.Height = 12
.Left = cell.Left + (cell.Width / 2) - (objOLE.Width / 2)
.Top = cell.Top + (cell.Height / 2) - (objOLE.Height / 2)
.Name = "Checkbox_" & cell.Address
.LinkedCell = cell.Worksheet.Name & "!" & cell.Address
'.Placement = xlMove
.Placement = xlMoveAndSize
.Object.Value = False
.Object.BackStyle = fmBackStyleTransparent
'.Object.BackStyle = fmBackStyleOpaque
.Object.TripleState = False 'True
.Object.Caption = ""

End With

Next

End Sub

 

[Yongle]

For future postings
Clicking on # icon above reply window inserts code tags into the reply and makes code much easier to read - it is auto-formatted like in VBA ( see my code below)
[ CODE ] paste code here [ /CODE ]

What needs to happen
Find a trigger, loop through all checkboxes on sheet, apply the code you already used

Practicality
Unfortunately Height and Width changes do not trigger an event so simply choose a way to run CentreCheckBoxes
- a button ?
- when activating \ deactivating sheet ?
- simple change in cell selection (as below)
- etc

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call LoopObjects
End Sub

Sub CentreCheckBoxes()
    Dim obj As OLEObject, cel As Range
    For Each obj In ActiveSheet.OLEObjects
        Set cel = obj.TopLeftCell
            With cel
                obj.Left = .Left + (.Width / 2) - (obj.Width / 2)
                obj.Top = .Top + (.Height / 2) - (obj.Height / 2)
            End With
    Next
End Sub

 

[Yongle]

oops - I changed the name of the sub and forgot to do the same in event macro which of course should be ..

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call [I]CentreCheckBoxes[/I]
End Sub

 

[Yongle]

Another trigger option for you
- run CentreCheckBoxes when a different cell is selected after column width change or row height change
- looks at total width of sheet + total height of sheet
- requires one Public Variable per sheet

at TOP of standard module

Public Old_WH As Double

In sheet module

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim new_WH As Double
    new_WH = Me.Range("A1").Resize(Rows.Count).Height + Me.Range("A1").Resize(, Columns.Count).Width
    If new_WH <> Old_WH Then
        Old_WH = new_WH
        Call CentreCheckBoxes
    End If
End Sub

 

[peterghost]

Thank you very much! You were quite helpfull!