Excel VBA:将形状添加到工作表时,位置只差一点点

Excel VBA:将形状添加到工作表时,位置只差一点点,vba,excel,shapes,Vba,Excel,Shapes,因此,我正在创建一个电子表格,它将查找列标题,并在列标题下的某一行中的单元格中添加一个形状。然而,当我运行代码时,列号较小(更接近原点)的形状非常接近,但是列30+中的形状有一点错误,并且稍微偏离了它们应该位于的位置。这是我的密码 Public Function Drawshape(ByVal shaperow As Integer, ByVal thisrow As Integer, shapecase As Integer) Dim shpcol As Integer Dim sh

因此,我正在创建一个电子表格,它将查找列标题,并在列标题下的某一行中的单元格中添加一个形状。然而,当我运行代码时,列号较小(更接近原点)的形状非常接近,但是列30+中的形状有一点错误,并且稍微偏离了它们应该位于的位置。这是我的密码

Public Function Drawshape(ByVal shaperow As Integer, ByVal thisrow As Integer, shapecase As      Integer)
Dim shpcol As Integer
Dim shpleft As Double
Dim shptop As Double
Dim shpwidth As Double
Dim shpheight As Double

'the columns are the day part of a date, so I find the cell that is "x" right of 
'the first date, where "x" is calculated based on another sheet.
shpcol = DateDiff("d", Sheet1.Cells(2, 2), Sheet1.Cells(thisrow, 9 + shapecase)) + 2
shpleft = Sheet2.Cells(shaperow, shpcol).Left
shptop = Sheet2.Cells(shaperow, shpcol).Top
shpwidth = Sheet2.Cells(shaperow, shpcol).Width
shpheight = Sheet2.Cells(shaperow, shpcol).Height

'depending on what shapecase is, the date I get is different, and the output shape is different
Select Case shapecase
    Case 0
        Sheet2.Shapes.AddShape(msoShapeOval, shpleft, shptop, shpwidth, shpheight).Fill.ForeColor.RGB = RGB(255, 255, 255)
    Case 1
        Sheet2.Shapes.AddShape(msoShapeIsoscelesTriangle, shpleft, shptop, shpwidth, shpheight).Fill.ForeColor.RGB = RGB(255, 255, 255)
    Case 2
        Sheet2.Shapes.AddShape(msoShapeOval, shpleft, shptop, shpwidth, shpheight).Fill.ForeColor.RGB = RGB(0, 0, 0)
    Case 3
        Sheet2.Shapes.AddShape(msoShapeIsoscelesTriangle, shpleft, shptop, shpwidth, shpheight).Fill.ForeColor.RGB = RGB(0, 0, 0)
    Case Else
        MsgBox "Shapes failed"
End Select
End Function
我似乎在任何地方都找不到答案,我真的希望这不是一个Excel bug

当我尝试时:

Debug.Print Sheet2.Shapes("Isosceles Triangle 1744").Left
Debug.Print Sheet2.Range("BG10").Left       'The cell where the shape is supposed to live
我得到
1425.333

1416所以我想我可能已经找到了答案,即使不是很令人满意。多亏了GSerg提供的测试建议,我才得以摆弄这些东西。我发现,当我选择所有单元格(通过单击电子表格的左上角)并同时调整它们的大小时,我可能会影响偏移。如果我把单元格做得太窄,形状就会偏离原来的位置。如果我把单元格做得太宽,形状就会偏离它们应该在的位置。垂直尺寸也产生了类似的影响

有趣的是,如果我以这种方式调整所有单元格的大小,直到形状匹配,然后选择单个列来调整大小,这对偏移量没有影响


我不知道为什么会这样,也不知道这是怎么解决的。但我的问题现在消失了?所以大家干得好吗?我想是吧?如果有人能说出发生这种情况的原因,我仍然很高兴宣布他们是这个问题的胜利者。

当你说他们不在时,他们的差距是多少?如果你数到那一点的细胞数,比如说10个细胞,你是不是减少了10个像素?有边界吗?我编辑了原始帖子。我的细胞很小。在我的电子表格的最右侧,偏移量大约是我无法复制的形状大小的一半(100%缩放时大约为1/4英寸,仅供参考)。创建一个新工作簿并执行以下操作:
for I=1到50:Me.Shapes.AddShape msoShape16pointStar,Me.Cells(I,I)。Left,Me.Cells(I,I)。Top,Me.Cells(I,I)。Width,Me.Cells(I,I).Height:Next
。你得到了什么?谢谢@GSerg,这帮了大忙。我也无法在空白的电子表格中复制它。我不知道为什么。请参见下面的答案。