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

我在Excel中创build了一些电话协议表，我想添加一个四边形纸的部分为草图的目的。 所以我在VBA中写了一个非常简单的macros，在选定的范围内绘制了水平和垂直的线条：

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

我怀疑这些线条是随着细胞移动的。 尝试将对象定位属性设置为“不要移动或使用单元格的大小”，其英文值为xlFreeFloating 。

例：

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

---

编辑

有趣的行为…我仍然认为它与单元格和边距有关，因为即使位置设置为自由forms，线条随着打印预览中的单元格宽度变化而移动。

我确实通过将这些行分组在一起find了解决方法。

增加了三行代码。 在创build“水平”和“垂直”线之后，将以下内容添加到两个块中。

 .Select Replace:=False 

现在在sub的最后加上这一行：

 Selection.Group 

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

打印预览的结果图像。

---

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

 ' 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