Vba 如何避免图形对象在屏幕上和打印出来时的不同布局？

我在excel中创建了一些电话协议表，我想添加一个带有四边形纸的部分，用于绘制草图。因此，我用VBA编写了一个非常简单的宏，在选定范围内绘制水平线和垂直线：

Public Sub Fill()

    Dim angepeilteMaschenWeiteInPixel As Integer
    angepeilteMaschenWeiteInPixel = 15

    Dim LinienFarbe As Long
    LinienFarbe = RGB(220, 220, 220)

    Dim obenLinks As Double, obenRechts As Double
    Dim untenLinks As Double, untenRechts As Double
    Dim ausgewaehlteRange As Range

    Set ausgewaehlteRange = Selection

    ' Anzahl Spalten und Zeilen ermitteln bei idealer Breite/Höhe 10px

    Dim idealeSpaltenAnzahl As Integer
    Dim idealeZeilenAnzahl As Integer

    idealeSpaltenAnzahl = CInt(Round((ausgewaehlteRange.Width / angepeilteMaschenWeiteInPixel), 0))
    idealeZeilenAnzahl = CInt(Round((ausgewaehlteRange.Height / angepeilteMaschenWeiteInPixel), 0))

    ' Aus der idealen Spalten- und Zeilenanzahl die ideale Maschenweite und - höhe in Pixeln ermitteln

    Dim idealeMaschenBreite As Double
    Dim idealeMaschenHoehe As Double

    idealeMaschenBreite = ausgewaehlteRange.Width / CDbl(idealeSpaltenAnzahl)
    idealeMaschenHoehe = ausgewaehlteRange.Height / CDbl(idealeZeilenAnzahl)

    ' vertikale Linien zeichnen

    Dim i As Integer

    For i = 1 To idealeSpaltenAnzahl - 1

        Dim horizontal As Integer
        horizontal = CInt(ausgewaehlteRange.Left + i * idealeMaschenBreite)

        Dim oben As Integer
        oben = Round(ausgewaehlteRange.Top, 0)

        Dim unten As Integer
        unten = Round(oben + ausgewaehlteRange.Height, 0)


        With ActiveSheet.Shapes.AddLine(horizontal, oben, horizontal, unten).Line
            .ForeColor.RGB = LinienFarbe



        End With

    Next i

    ' horizontale Linien zeichnen

    Dim j As Integer


    For j = 1 To idealeZeilenAnzahl - 1

        Dim vertikal As Integer
        vertikal = CInt(ausgewaehlteRange.Top + j * idealeMaschenHoehe)

        Dim links As Integer
        links = CInt(Round(ausgewaehlteRange.Left, 0))

        Dim rechts As Integer
        rechts = CInt(Round(links + ausgewaehlteRange.Width, 0))


        With ActiveSheet.Shapes.AddLine(links, vertikal, rechts, vertikal).Line
            .ForeColor.RGB = LinienFarbe



        End With

    Next j

End Sub

在excel中，一切看起来都很好：

但在打印预览和打印输出中，水平线间隙不均匀，我不知道为什么：

---

有人能帮我吗？

我怀疑这些细胞在移动。尝试将“对象定位”属性设置为“不移动单元格或调整单元格大小”，其英文值为

xlFreeFloating

例如：

With ActiveSheet.Shapes.AddLine(links, vertikal, rechts, vertikal)
    .Line.ForeColor.RGB = LinienFarbe
    .Placement = xlFreeFloating
End With

---

编辑

有趣的行为。。。我仍然认为这与单元格和边距有关，因为在打印预览中，行会随着单元格宽度的变化而移动，即使“位置”设置为“自由形式”

我确实找到了一个解决办法，将这些行组合在一起

添加了三行代码。在创建水平线和垂直线后，将以下内容添加到With块

.Select Replace:=False

现在将这一行添加到子项的末尾：

Selection.Group

现在，刚刚创建的所有行都被分组在一起

打印预览的结果图像

---

供您参考的最后一个代码块示例：

' horizontale Linien zeichnen
Dim j As Integer

For j = 1 To idealeZeilenAnzahl - 1
    Dim vertikal As Integer
    vertikal = CInt(ausgewaehlteRange.Top + j * idealeMaschenHoehe)

    Dim links As Integer
    links = CInt(Round(ausgewaehlteRange.Left, 0))

    Dim rechts As Integer
    rechts = CInt(Round(links + ausgewaehlteRange.Width, 0))

    With ActiveSheet.Shapes.AddLine(links, vertikal, rechts, vertikal)
        .Line.ForeColor.RGB = LinienFarbe
        .Placement = xlFreeFloating
        .Select Replace:=False
    End With
Next j

Selection.Group
End Sub

---

不幸的是，这没有任何效果。它看起来仍然和上面的截图一样。你能通过Dropbox或类似的方式共享你的文件吗？去掉任何机密。当然，给你：。目前还没有访问宏的快捷方式。“清除”用于清除所有行，“填充”用于用行填充选定范围。谢谢，请查看我的编辑。我找到了一个可能对你有用的方法。这完全奏效了，我自己永远也不会明白。谢谢