1つのシートから値を読み取り、別のシートに「ラベル」を作成するVBAスクリプトを作成しました。
このラベルは、3つの部分に分割された特殊な用紙に印刷されることになっています。
私はスウェーデンに住んでいるので、A4用紙サイズ(297x210 mm)を使用します。ラベルは99x210 mmと想定されています。
これは、各値を用紙の正確な位置に印刷する必要があることを意味します。
私はこれを私の会社で行っているので、すべてのコンピュータはまったく同じです。
同じモデル、同じバージョンの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 mm、次にそれらの間の99 mmである必要があります。
ここでテストしたい場合は、ファイル全体をアップロードしました: http://hoppvader.nu/docs/Streckkod.xlsm
使用されるのはmodule3のみであることに注意してください。module2は、00-99以外のチェック番号「Checksiffra」を選択した場合です。
それが私のコンピュータでしか機能しない理由について、どんな助けもありがたいです。
出力は、プリンターの解像度、デスクトップの解像度、フォント、セルのサイズなど、多くの影響を受ける可能性があります。
たとえば、新しいシートに10cm x 10cmの正方形を描くと、ページ設定と詳細オプションでスケーリングが無効になっているにもかかわらず、印刷結果は10.5cm x 9.5cmの長方形になります。
正確な出力を得るには、このタイプのシートの描画はセンチメートル単位で提供された正確なサイズで印刷されるため、1つの解決策はチャートシートにコンテンツを描画することです。
次に、Chartシートを追加してラベルを作成する例を示します。
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
列の幅を確認し、コンピューターの列の幅を他の列の幅と比較します。異なる場合は、フォントバージョンの問題である可能性があります。
すべてのコンピュータに同じフォントバージョンをインストールしてください。
ここでの問題は、おそらくExcelが文字幅によって列幅を決定することです( Excelでの列幅の決定方法の説明 を参照)。したがって、フォントが変更されると、列幅が変更されます。
Microsoft Updateが文字幅の異なる間違ったフォントファイルを配信したときに、私はそのようないくつかの問題を抱えていました。これらの間違ったファイルの1つが自分または他のコンピューターにある場合、列幅は間違って計算されます。
以下も参照してください: Excelの列のピクセル幅がマシンによって異なるが、OS、解像度、Excelバージョンなどが同じである理由
印刷に行くときのオプションがあるはずです:「スケールに合わせる」それは詳細オプションにあるかもしれません。 Macでは「詳細を表示」をクリックする必要がありました
私はとてもvbaを使用していました。そして、コンピュータープログラマーです。しかし、問題はコードの問題ではないようです。
pS-あなたはおそらくマクロを介して「スケールに合わせる」を可能にする方法を見つけることができます。プログラミングソリューションを確認するためのリソースを以下に示します。 https://www.ozgrid.com/forum/forum/help-forums/Excel-general/5968-force-printing-macro-to-fit-page
https://www.experts-exchange.com/questions/28156905/VBA-Print-Code-Print-Area-Fit-on-one-page.html
patrick Matthewsによって解決された上記のリンクからの抜粋
With Worksheets("name").PageSetup
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With
@Andreasに応答して、コードスニペットはどうですか?
さらに、.FitToPagesTallを削除します
With Worksheets("name").PageSetup
.Zoom = False
.FitToPagesWide = 1
End With
うまくいけば、それは垂直方向には整列しませんが、依然として水平方向に整列します。
別のコンピューターで同じファイルを使用することは問題ではないようです。ファイルは、ドキュメントの印刷最終結果に影響を与える多くの要因の1つにすぎません。
Windowsプリンタードライバーは、コンピューターごとに異なるバージョンである可能性があります(つまり、一方では更新されましたが、他方では更新されていません)
Windowsプリンターの設定は、コンピューターごとに少し異なる場合があります。
2台のコンピューターが同一であり、これらの設定を変更できないことは間違いありませんが、一見同一のワークステーションでは、このような違いが常に発生します常時予期しない変数がいくつも原因です。 (つまり、「Windows Updateが2台のマシンにプッシュされたときに、そのうちの1台が誤って電源がオフになり、アップデートを適切に取得またはインストールできませんでした。」)
さまざまなレベルで隠されている、問題の潜在的な原因であると思われる大量のプリンター設定やその他の変数が山ほどあります。 (つまり、システムレベル、デバイスレベル、アプリケーションレベル)
以下に、違反者と思われる3つのプロパティセットを見つける方法を示します。 すべての3つの場所を両方コンピュータからチェックして、設定を比較します。
ヒット Windowsキー、device manger
と入力してプッシュ Enter
Imaging Devices
をダブルクリックし、目的のプリンターを右クリックしてProperties
を選択します
Driver
タブをクリックし、Driver Date
とDriver Version
をメモします
一致しない場合は一致させます。これらの領域のいずれにもアクセスできない場合、または変更するオプションがわからない場合は、IT部門に確認してください。部門。
ヒット Windowsキー、printers
と入力してプッシュ Enter
目的のプリンターを右クリックし、Printer Preferences
を選択します
このウィンドウのレイアウトは、プリンターの製造元によって異なります。 allタブのall値を確認し、2つのマシンの2つの設定の違いを探します。
Control Panel
→Hardware and Sound
→Devices and Printers
に移動します
目的のプリンターを右クリックし、Printer Properties
を選択します
allタブのall値を確認し、2つのマシンの2つの設定の違いを探します。
最後に、両方のコンピュータから目的のプリンタで テストページ を印刷し、違い(バージョン番号を含む)がないかどうかを綿密に検査します。