需求: Excel 中有多组checkbox复选框,需要把选中的复选框和未选中的复选框标记入库。
如果选中则给1没有选中给所在单元格赋0
先上图:
VB :
Sub btn_onclick()
Set myDocument = Worksheets(1) ' 即 Worksheets("Sheet1")
Dim i As Integer
Debug.Print "count:" & myDocument.Shapes.Count
For i = 1 To myDocument.Shapes.Count
If InStr(1, myDocument.Shapes(i).Name, "Check Box") Then
Dim addr As String
Dim irow1 As Integer
Dim iCol1 As Integer
addr = myDocument.Shapes(i).TopLeftCell.Address
irow1 = myDocument.Shapes(i).TopLeftCell.Row
iCol1 = myDocument.Shapes(i).TopLeftCell.Column
irow1 = irow1 + 1 '如果出现错位可以自行调整,不支持合并单元格的情况
Debug.Print "addr:" & addr & "=row:" & irow1 & "=Col:" & iCol1
Dim b As String
b = myDocument.Shapes(i).DrawingObject.Value
Debug.Print "is checked :" & b
If b = 1 Then
'根据实际情况看看addr是不是能直接取到值
'myDocument.Range(addr).Value = 1
myDocument.Range(Cells(irow1, iCol1), Cells(irow1, iCol1)).Value = 1
Else
myDocument.Range(Cells(irow1, iCol1), Cells(irow1, iCol1)).Value = 0
End If
'Debug.Print "ok..."
End If
Next
MsgBox "complate!"
End Sub
备注:
'Sheet1.Range("G1:I16, B1:C5").Select
'Dim rng As Range
'Dim objexcel As Excel.Application
'Set rng = Sheet1.Range("H9")
'Dim rng As Range
'Set rng = Sheet1.Range("A65536").End(xlUp)
'Sheet1.OLEObjects("CheckBox1").Object.Value = 1
'Worksheets("Sheet1").Shapes.SelectAll
参考资料:
http://club.excelhome.net/thread-395683-1-1.html
http://www.feiesoft.com/vba/excel/xlobjSheets.htm