循环通过ActiveXcheckbox,重命名和更改链接的单元格,然后复制并重复

我试图创build一个macros,将重命名,然后更改多个活动xcheckbox的链接的单元格,然后复制一个新的集合,并重复该过程。 它将需要循环约200次。 基本上我需要200套checkbox的属性(名称),如下所示:

SET 1(有效的X个checkbox)

  • FL1MON(链接单元:C5)
  • FL1TUE(链接单元格:D5)
  • FL1WED(链接单元:E5)
  • FL1THU(链接单元格:F5)
  • FL1FRI(链接单元格:G5)
  • FL1SAT(链接单元:H5)
  • FL1SUN(链接单元格:I5)

SET 2(有效的x个checkbox)

  • FL2MON(链接单元:C25)
  • FL2TUE(链接单元格:D25)
  • FL2WED(链接单元:E25)
  • FL2THU(Link Cell:F25)
  • FL2FRI(Link Cell:G25)
  • FL2SAT(链接单元:H25)
  • FL2SUN(链接单元:I25)

(并重复)…

我在下面附上一些代码; 不过,我相信我很有可能走错了方向。 此外,我还没有弄清楚我将如何改变循环中的链接单元格。

Sub CopyDown_Boxes() Dim oles1 As OLEObject Dim oles2 As OLEObject Dim oles3 As OLEObject Dim oles4 As OLEObject Dim oles5 As OLEObject Dim oles6 As OLEObject Dim oles7 As OLEObject i = (x * 15) + 5 For x = 1 To 7 Set oles1 = ThisWorkbook.Worksheets("Flight Schedule").OLEObjects("CheckBox1") Set oles2 = ThisWorkbook.Worksheets("Flight Schedule").OLEObjects("CheckBox2") Set oles3 = ThisWorkbook.Worksheets("Flight Schedule").OLEObjects("CheckBox3") Set oles4 = ThisWorkbook.Worksheets("Flight Schedule").OLEObjects("CheckBox4") Set oles5 = ThisWorkbook.Worksheets("Flight Schedule").OLEObjects("CheckBox5") Set oles6 = ThisWorkbook.Worksheets("Flight Schedule").OLEObjects("CheckBox6") Set oles7 = ThisWorkbook.Worksheets("Flight Schedule").OLEObjects("CheckBox7") oles1.Name = "FL" & x & "MON" oles2.Name = "FL" & x & "TUE" oles3.Name = "FL" & x & "WED" oles4.Name = "FL" & x & "THU" oles5.Name = "FL" & x & "FRI" oles6.Name = "FL" & x & "SAT" oles7.Name = "FL" & x & "SUN" Worksheets("Flight Schedule").Shapes.Range(Array("FL" & x & "MON", "FL" & x & "MON", "FL" & x & "MON", _ "FL" & x & "MON", "FL" & x & "MON", "FL" & x & "MON", "FL" & x & "MON")).Select Selection.Copy Range("B" & i).Select ActiveSheet.Paste Next x End Sub 

稍微不同的方法也许给你一个select。 我已经使用单元格alignment作为定位checkbox的基础,并将这些集合垂直放置以与“链接单元格”行alignment。 这个例子只是将它们生成到活动工作表中。

复选框集

 Sub multiCheck() Dim chkRow As Long, chkCol As Long, LastRow As Long, x As Long Dim chkLeft As Double, chkTop As Double, chkHeight As Double Dim chkWidth As Double, numOfSets As Double, linkCellSpace As Double Dim linkCellRow As Double, linkCellColStart As Double, setSpacing As Integer Dim chkSet As Integer, chkSpace As Integer Dim wkArr() As Variant 'initial values chkRow = 3 chkCol = 2 chkSpace = 2 setSpacing = 6 LastRow = 20 linkCellRow = 5 linkCellSpace = 20 linkCellColStart = 2 'no of week sets numOfSets = 3 wkArr() = Array("MON", "TUE", "WED", "THU", "FRI", "SAT", "SUN") 'for each week set For chkSet = 0 To numOfSets - 1 'for each day of week For x = 1 To 7 chkRow = chkRow + chkSpace chkLeft = Cells(chkRow, chkCol).Left chkTop = Cells(chkRow, chkCol).Top chkHeight = Cells(chkRow, chkCol).Height chkWidth = Cells(chkRow, chkCol).Width ActiveSheet.CheckBoxes.Add(chkLeft, chkTop, chkWidth, chkHeight).Select With Selection .Name = "FL" & chkSet + 1 & wkArr(x - 1) .Caption = .Name .Display3DShading = True .LinkedCell = Cells(linkCellRow + (linkCellSpace * chkSet), linkCellColStart + x).Address End With Next x chkRow = chkRow + setSpacing Next chkSet End Sub 

编辑大小/移动与细胞的活动-Xcheckbox

按要求修改。 将flightSheet设置为适当的工作表。 该代码默认情况下将checkbox设置为FALSE

在这里输入图像说明

 Option Explicit Sub multiCheckActiveX() Dim chkBox As New OLEObject Dim flightSheet As Worksheet Dim chkRow As Long, chkCol As Long, LastRow As Long, x As Long Dim chkLeft As Double, chkTop As Double, chkHeight As Double Dim chkWidth As Double, numOfSets As Double, linkCellSpace As Double Dim linkCellRow As Double, linkCellColStart As Double, setSpacing As Integer Dim chkSet As Integer, chkSpace As Integer Dim wkArr() As Variant 'initial values chkRow = 3 chkCol = 2 chkSpace = 2 setSpacing = 6 LastRow = 20 linkCellRow = 5 linkCellSpace = 20 linkCellColStart = 2 'no of week sets numOfSets = 3 Set flightSheet = Sheets("Sheet2") wkArr() = Array("MON", "TUE", "WED", "THU", "FRI", "SAT", "SUN") With flightSheet 'for each week set For chkSet = 0 To numOfSets - 1 'for each day of week For x = 1 To 7 chkRow = chkRow + chkSpace chkLeft = .Cells(chkRow, chkCol).Left chkTop = .Cells(chkRow, chkCol).Top chkHeight = .Cells(chkRow, chkCol).Height chkWidth = .Cells(chkRow, chkCol).Width Set chkBox = .OLEObjects.Add(ClassType:="Forms.CheckBox.1") With chkBox .Left = chkLeft .Top = chkTop .Width = chkWidth .Height = chkHeight .Name = "FL" & chkSet + 1 & wkArr(x - 1) .Object.Caption = .Name .Object.SpecialEffect = 2 .LinkedCell = flightSheet.Cells(linkCellRow + (linkCellSpace * chkSet), linkCellColStart + x).Address .Object.Value = False .Placement = xlMoveAndSize End With Next x chkRow = chkRow + setSpacing Next chkSet End With End Sub