循环通过ActiveX复选框，重命名和更改链接的单元格，然后复制和重复
循环通过ActiveX复选框，重命名和更改链接的单元格，然后复制和重复
提问于 2014-11-25 20:13:37
我正在尝试创建一个宏，它将重命名，然后更改多个active x复选框的链接单元格，然后复制一个新集并重复这个过程。它需要被循环大约200次。基本上，我需要200个带有属性(名称)的复选框，如下所示：
集合1(活动x复选框)
- FL1MON (链路单元: C5)
- FL1TUE (链路单元: D5)
- FL1WED (链路单元: E5)
- FL1THU (链路单元: F5)
- FL1FRI (链路单元: G5)
- FL1SAT (链路单元: H5)
- FL1SUN (链路单元: I5)
集合2(活动x复选框)
- FL2MON (链路单元: C25)
- FL2TUE (链路单元: D25)
- FL2WED (链路单元: E25)
- FL2THU (链路单元: F25)
- FL2FRI (链路单元: 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回答 1
Stack Overflow用户
回答已采纳
发布于 2014-11-25 22:42:31
一种稍微不同的方法，也许可以给你一个选择。我使用与单元格对齐作为定位复选框的基础，并将集合垂直定位以与“链接单元格”行对齐。此示例只将它们生成到活动工作表中。
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编辑ACTIVE-X复选框，该复选框与单元格一起大小/移动
应要求作出修正。将flightSheet设置为适当的工作表。默认情况下，代码将复选框设置为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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/27135830
复制相关文章
相似问题
腾讯云开发者
