你如何避免屏幕上的Shape对象的不同布局并打印出来？

Question

我在excel中创建了某种电话协议表，我想添加一个带有quadrille纸的部分用于绘制草图。因此，我在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中，一切看起来都很好：

但在打印预览中也打印出来，水平线间隙不均匀，我不明白为什么：

有谁可以帮助我？

Answer 1

我怀疑线条随细胞移动。尝试将对象定位属性设置为＆＃34;不要使用单元格移动或调整大小＆＃34;其中英文值为xlFreeFloating。

示例：

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

修改

有趣的行为......我仍然认为它与细胞和细胞有关。即使位置设置为自由形式，当打印预览中的单元格宽度更改时线条移动的边距。

我确实通过将这些线组合在一起找到了解决方法。

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

.Select Replace:=False

现在在sub：

的末尾添加这一行

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