Another Check-box problem

G

Glen

Hopefully someone will be able to provide me with an answer for this
one. I am having a lot of difficulty getting VBA to place check boxes
inside the linked cells. I believe the problem with the process is a
result of the varying size of the rows. Is there a way to place these
check box objects inside the appropriate cell without modifying the
spreadsheet layout?

I have created a spreadsheet which pulls most of its information from 3
different access databases. This data is presented in a spreadsheet at
the user's request. Now the end-user wants to add the check box in the
1st column (Lucky me) as an indicator for quality control. I am trying
to modify the spreadsheet as little as possible and as a result I am
trying to add these checkboxes at the end of processing the data when
the spreadsheet is formatted with "size-to-fit" cells. Below is the
process I am using to create the check boxes. It is a modification of
code I found earlier on this website and I am sorry but I didn't
bookmark the programmer to provide recognition in this post. Thank you
very much for any help you can provide.

Dim myCBX As CheckBox
Dim myCell As Range
Dim cntr As Integer

cntr = rowcount + 1
Columns("A:A").Select
With Selection
.Insert Shift:=xlToRight
.ColumnWidth = 6
End With

Columns("B:D").Select 'Formatting of header cells
With Selection 'cause me to delete these now
.Delete Shift:=xlToLeft
End With

With ActiveSheet
For Each myCell In Range("A6:A" & cntr & "")
Set ChkBox = ActiveSheet.CheckBoxes.Add _
(myCell.Left, myCell.Top, _
myCell.Width, myCell.Height)
ChkBox.LinkedCell = myCell.Address
ChkBox.Caption = ""
Next myCell
End With
 
G

Glen

In case anybody sees this post and needs to know the answer to this
problem, here is the solution I came up with:

Public Sub Check_Set(indx As Integer)
' This code will place a checkbox into each cell and
' allow the rows to be sized without altering the
' anchored position of the checkbox within the linked cell.
' It will only place check boxes in rows where data is
' located in a control column. For me, that is column "I".

' This sub will insert check boxes into column "A".
' These check boxes are linked to the cells they rest on
' top of and start at Row 6 for me because I have 5 rows
' of header data for each spreadsheet. They are to be used
' by the end-user to indicate a correction in the worksheet.
' They will be used to indicate update actions to the back-end
' database in access. 'indx' is an argument passed by the
' calling procedure to indicate the sheet number
' requiring formatting
'
On Error GoTo check_set_err
Dim myCell As Range 'cell object, Checkboxes will be
' individually linked to these cells
Dim rcntr As Integer 'Total count of rows with valid data
Dim OLEObj As OLEObject 'for ActiveX checkboxes
' placed in spreadsheet
Dim count As Integer 'start value for linked cells
Dim topl As Double 'start value for checkbox placement,
' each row is 12.75 pixel height
' start value is 65 pixels, 12.75 * 5(rows)
' + 1.25 (spacing from row 1)

rcntr = Cells(Rows.count, "I").End(xlUp).row
topl = 65
count = 6

Columns("A:A").Select
With Selection
.Insert Shift:=xlToRight
.ColumnWidth = 6
End With

If indx = 1 Then
Columns("B:B").Select
With Selection
.Delete Shift:=xlToLeft
End With
End If

For count = 6 To rcntr
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Link:=False, DisplayAsIcon:=False, Left:=7.5, Top:=topl, _
Width:=12.75, Height:=9).Select
topl = topl + 12.75
Next

For Each OLEObj In ActiveSheet.OLEObjects
With OLEObj
.LinkedCell = .TopLeftCell.Address(External:=True)
.TopLeftCell.NumberFormat = ";;;"
.Object.Value = False
End With
Next OLEObj
exitsub:
Exit Sub

check_set_err:
MsgBox Err.Description, vbCritical, "Error: Check_Set Procedure!"
Resume exitsub

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top