VB 给Excel中的checkbox 所在单元格赋值

需求： 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    NextMsgBox "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