两台不同计算机上的同一文件如何给出不同的结果？
And*_*eas 15 printing excel vba excel-vba
我制作了一个VBA脚本,它将从一张纸上读取值并在另一张纸上创建一个"标签".
该标签应该印在特殊纸张上,该纸张分为三部分.
由于我住在瑞典,我们使用A4纸张尺寸(297x210毫米).标签应该是99x210毫米.
这意味着每个值都需要打印在纸张上的确切位置.
我这样做是为了我的公司,因此所有的自动取款机都是一样的.
相同型号,相同版本的Windows,相同版本的Excel.
这是代码的一小部分(与文本定位有关)
For i = 2 To Lastrow
' Location name
Sheets("Etikett").Range("A" & intRad) = Sheets("Bins").Range("A" & i)
With Sheets("Etikett").Range("A" & intRad & ":K" & intRad)
.MergeCells = True
.Font.Color = clr
.Font.Size = 150
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThick
.Borders.Color = clr
.Borders(xlEdgeLeft).Weight = xlThick ' this may look odd but is needed
.Borders(xlEdgeRight).Weight = xlThick
End With
'Checknumber
Sheets("Etikett").Range("B" & intRad + 1) = Sheets("Bins").Range("B" & i)
With Sheets("Etikett").Range("B" & intRad + 1 & ":D" & intRad + 1)
.MergeCells = True
.Font.Color = clr
.Font.Size = 100
.NumberFormat = "00"
.Font.Bold = True
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
' old location
If Sheets("Bins").Range("E" & i) <> "" Then
Sheets("Etikett").Range("K" & intRad + 1) = Sheets("Bins").Range("E" & i)
With Sheets("Etikett").Range("K" & intRad + 1)
.MergeCells = True
.Font.Color = clr
.Font.Size = 8
.Font.Bold = True
.VerticalAlignment = xlBottom
.HorizontalAlignment = xlLeft
End With
End If
' copy already premade barcode or generate barcode if not premade
If Sheets("Bins").Cells(i, 2) < 100 Then
Sheets("0-99").Select
shp = "B" & Right("0" & Sheets("Bins").Cells(i, 2), 2)
Sheets("0-99").Shapes(shp).Select
Else
Sheets("VBA").Select
ThisWorkbook.ActiveSheet.Shapes.SelectAll
Selection.Delete
Code128Generate_v2 30, 0, 40, 2.5, ThisWorkbook.ActiveSheet, Sheets("Bins").Cells(i, 2), 200
ThisWorkbook.ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.Group.Select
End If
'color the barcode
Selection.ShapeRange.Line.ForeColor.RGB = clr
Selection.Copy
Sheets("Etikett").Select
Sheets("Etikett").Range("G" & intRad + 1 & ":J" & intRad + 1).MergeCells = True
' Set rowheights
Sheets("Etikett").Rows(intRad).RowHeight = 135
Sheets("Etikett").Rows(intRad + 1).RowHeight = 115
If Etikettcount Mod 3 = 0 Then ' if it's the last label on paper, no space is needed between this and the next.
Range("G" & intRad + 1).Select
intRad = intRad - 1
Else
Sheets("Etikett").Rows(intRad + 2).RowHeight = 25
Range("G" & intRad + 1).Select
End If
ActiveSheet.Paste ' paste barcode
Etikettcount = Etikettcount + 1
intRad = intRad + 3
End If
Next i
请记住,这不是所有代码,但这是复制文本和条形码并将它们放在工作表上的原因.
在我的计算机上输出是预期的:
打印输出
在其他计算机上,最后一个字符被略微切除,垂直对齐不正确.
正如我之前所写,我需要标签之间的空白区域距离顶部约99毫米,然后介于它们之间99毫米.
我已经上传了完整的文件,如果有人想在这里测试它:http:
//hoppvader.nu/docs/Streckkod.xlsm请注意,它只是使用的module3,如果你选择00以外的检查号"Checksiffra",则模块2 99.
任何帮助是值得赞赏的,为什么它只适用于我的电脑.
输出可能会受到许多因素的影响,例如打印机的分辨率,桌面的分辨率,字体或单元格的大小.
例如,当我在新工作表上绘制10厘米×10厘米的正方形形状时,即使在页面设置和高级选项中禁用了缩放,打印结果也是10.5厘米x 9.5厘米的矩形.
要获得准确的输出,一种解决方案是在图表工作表上绘制内容,因为此类工作表上的任何图纸都打印为以厘米为单位的确切尺寸:
这是添加图表工作表并创建标签的示例:
Sub DrawLabel()
' add new empty Chart sheet '
Dim ch As Chart
Set ch = ThisWorkbook.Charts.Add()
ch.ChartArea.ClearContents
ch.ChartArea.Format.Fill.Visible = msoFalse
ch.ChartArea.Format.line.Visible = msoFalse
' setup page as A4 with no margin '
ch.PageSetup.PaperSize = xlPaperA4
ch.PageSetup.Orientation = xlPortrait
ch.PageSetup.LeftMargin = 0
ch.PageSetup.TopMargin = 0
ch.PageSetup.RightMargin = 0
ch.PageSetup.BottomMargin = 0
ch.PageSetup.HeaderMargin = 0
ch.PageSetup.FooterMargin = 0
DoEvents ' force update '
' add labels
AddText ch, x:=0.5, y:=0.5, w:=19.9, h:=4.6, Color:=vbRed, Border:=3, Size:=150, Text:="DB136C"
AddText ch, x:=2.5, y:=5.1, w:=5, h:=4, Color:=vbRed, Border:=0, Size:=100, Text:="79"
AddText ch, x:=0.5, y:=10, w:=19.9, h:=4.6, Color:=vbGreen, Border:=3, Size:=150, Text:="DB317A"
AddText ch, x:=2.5, y:=14.6, w:=5, h:=4, Color:=vbGreen, Border:=0, Size:=100, Text:="35"
AddText ch, x:=0.5, y:=19.5, w:=19.9, h:=4.6, Color:=vbBlack, Border:=3, Size:=150, Text:="AA102A"
AddText ch, x:=2.5, y:=24.1, w:=5, h:=4, Color:=vbBlack, Border:=0, Size:=100, Text:="10"
End Sub
Private Sub AddText(self As Chart, x#, y#, w#, h#, Color&, Border#, Size#, Text$)
With self.Shapes.AddTextBox( _
msoTextOrientationHorizontal, _
Application.CentimetersToPoints(x) - 8, _
Application.CentimetersToPoints(y) - 8, _
Application.CentimetersToPoints(w), _
Application.CentimetersToPoints(h))
.line.Weight = Border
.line.ForeColor.RGB = Color
.line.Visible = Border <> 0
.TextFrame.VerticalAlignment = xlVAlignCenter
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame2.TextRange.Font.Name = "Calibri"
.TextFrame2.TextRange.Font.Size = Size
.TextFrame2.TextRange.Font.Bold = msoTrue
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = Color
.TextFrame2.TextRange.Text = Text
End With
End Sub
Tom*_*ski -1
我首先检查所有打印设置是否都按需要设置（打印机也有内部“默认”打印设置，可能会干扰所需的打印）。如果您使用的字体安装在工作计算机上。
然后，我将添加以下 VBA 代码，以确保所有计算机上的 Excel 打印设置都相同（这只是为了给您一个提示，并且只是可以设置的一小部分）
With Sheets("Etikett").PageSetup
.PaperSize = xlPaperA4
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
如果以上内容没有帮助...请阅读下文。
MS Office 打印有点棘手。问题是 Excel（不仅仅是 Excel）无法自行生成打印预览，那么它是做什么的呢？它将所有数据发送到打印机（因此是打印机完成这项工作）并只是“转发”回结果。这通常不是问题，并且在有人尝试设计像素完美的打印之前不会被注意到。
我在我的公司也遇到了类似的问题，我们在邮件贴纸上使用地址标签。在我们的打印机坏了之后，我们给自己买了一台闪亮的新打印机（完全不同的型号、品牌等），我们的模板一团糟，必须重新对齐。
所以总而言之，它可以归结为打印机驱动程序......