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
       myDocument.Range(Cells(irow1,iCol1),Cells(irow1,iCol1)).Value = 1
      Else
       myDocument.Range(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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!