VBA通过范围循环到引用单元格中的addhape

Question

我基本上要做的是在Excel中构建一个甘特图：每列代表一周。现在我想添加里程碑，我想通过在里程碑的周中心添加一个小点（形状）来实现。在我的数据中，我有一列（X）指定我需要放置形状的单元格;这对于每一行都是不同的。截图应该澄清我的意思。我可以用一行来完成，但是我在构建从单元格X11到X20的循环时遇到了问题。不确定它是否重要，但我不需要每一行都有里程碑;对于某些行，列X中的单元格为空。

现在我所拥有的是以下内容，但这会返回错误。我不知道为什么或如何解决这个问题。

Sub Bolletjes()

Const BallSize = 8
Const FirstColumnKV = "X"
Const FirstRowKV = 11

Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double

Dim findcellKV As Variant

Dim cl As Range
Dim shpOval As Shape
Dim Counter As Integer

For Counter = FirstRowKV To 20
findcellKV = Range(FirstColumnKV & Counter).Value
Set cl = Range(findcellKV)

clLeft = cl.Left
clTop = cl.Top
clOffsetV = cl.Height / 2 - BallSize / 2
clOffsetH = cl.Width / 2 - BallSize / 2

Set shpOval = ActiveSheet.Shapes.AddShape(msoShapeOval, clLeft + clOffsetH,clTop + clOffsetV, BallSize, BallSize)
shpOval.Fill.ForeColor.RGB = RGB(152, 52, 7)
shpOval.Line.ForeColor.RGB = RGB(152, 52, 7)
shpOval.Line.Weight = 1

Next

End Sub

Answer 1

好的，评论似乎太长了，所以我只是把它作为答案。

首先，如果您不想更改的值，则使用常量（Const - 关键字）。因此，为了您的目的，您应将它们定义为变量，最好定义为Long。

其次，IMO在VBA代码中使用索引字母并不是很顺利。尝试使用索引号来引用单元格或列。你可以添加，繁殖和做许多其他有趣的东西，你只能用索引字母。

至于你的代码：

Sub Bolletjes()

Dim ws as Worksheet

Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double

Dim BallSize As Long
Dim FirstColumnKV As Long
Dim FirstRowKV As Long
Dim findcellKV As Variant

Dim cl As Range
Dim shpOval As Shape
Dim Counter As Integer

'set x equal to the id of your sheet
Set ws = ThisWorkbook.Worksheets(x)
BallSize = 8
FirstColumnKV = 24
FirstRowKV = 11

For Counter = FirstRowKV To 20
findcellKV = ws.Range(Counter, FirstColumnKV).Value
Set cl = ws.Range(Counter, FirstColumnKV)

clLeft = cl.Left
clTop = cl.Top
'I'm pretty sure that this wont work, but I cant test it, without your file. 
clOffsetV = (cl.Height / 2) - (BallSize / 2)
clOffsetH = (cl.Width / 2) - (BallSize / 2)

'Also not sure if this will work.
Set shpOval = ActiveSheet.Shapes.AddShape(msoShapeOval, clLeft + clOffsetH,clTop + clOffsetV, BallSize, BallSize)
shpOval.Fill.ForeColor.RGB = RGB(152, 52, 7)
shpOval.Line.ForeColor.RGB = RGB(152, 52, 7)
shpOval.Line.Weight = 1

Next

End Sub

另外，据我所知，这将是一个＆＃34; Ball＆＃34;在你循环的每个细胞中。你必须插入某种if - 语句，你想要你的形状。

Answer 2

@Tom，感谢您的精心回复。但是，出于某种原因，定义为“Counter，FirstColumnKV”的范围似乎不起作用。而当我将FirstColumnKV设置为“X”并使用“FirstColumnKV＆amp; Counter”时，它确实可以正常工作。无论如何，现在解决了原来的问题。问题是缺少If语句和一些轻微的重新排列。我将发布代码，因为它现在是好的措施：

Sub Bolletjes()

Dim Wb As Workbook
Dim Ws As Worksheet

Const BallSize = 8
Const FirstColumnKV = "X"
Const FirstRowKV = 11

Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double

Dim findcellKV As Variant

Dim cl As Range
Dim shpOval As Shape
Dim Counter As Integer

Set Ws = ActiveWorkbook.Sheets("C_Portfolio")

For Counter = FirstRowKV To 19
findcellKV = Ws.Range(FirstColumnKV & Counter).Value

If Format(Range(FirstColumnKV & Counter).Value) <> vbNullString Then
Set cl = Range(findcellKV)
clLeft = cl.Left
clTop = cl.Top
clOffsetV = cl.Height / 2 - BallSize / 2
clOffsetH = cl.Width / 2 - BallSize / 2

Set shpOval = ActiveSheet.Shapes.AddShape(msoShapeOval, clLeft + clOffsetH, clTop + clOffsetV, BallSize, BallSize)
shpOval.Fill.ForeColor.RGB = RGB(152, 52, 7)
shpOval.Line.ForeColor.RGB = RGB(152, 52, 7)
shpOval.Line.Weight = 1

End If

Next

End Sub