…aber teste doch mal das folgende kleine AddIn von meinem
WebSpace - damit bekommst Du zwei neue Buttons über die Du die
Zellengrösse in cm einstellen kannst.
http://users.quick-line.ch/ramel/Files/Spalte-Zeile_…
Je nach Schriftart/Drucker-Kombination kannst Du im VBA-Code
drin die Faktoren die zur Umrechnung dienen anpassen falls das
notwendig sein sollte:
Hallo Thomas,
ich habe da ein Problem mit dem Faktor 5.1425.
(mal abgesehen davon daß ich 5.041764706 hatte *grien*)
Wenn ich Columnwidth in Schritten von 0,01 erhöhe, und das dann mitprokolliere in einer Tabelle, links die eingestellte Columnwidth, rechts davon das Ergebnis wenn ich die Columnwidth auslese, so sehe ich daß Columnwidth eigenen Regeln folgt.
Es hüpft um 0 oder ,14 oder ,15 aber nicht um 0,0001.
Sub th()
Dim x, n
x = 10
For n = 1 To 100
x = x + 0.01
Range("A1").ColumnWidth = x
Cells(n, 1) = x
Cells(n, 2) = Range("A1").ColumnWidth
Next n
End Sub
und daß es gar nix bringt genauer als 2 Nachkommastellen zu gehen. Warum also 5.1425 !?
Und wenn ich links den Rand auf 2cm setze, rechts auf 3 cm, dann die Breite von A1:stuck_out_tongue:1 auf jeweils 1cm, so wird leider Spalte P nicht mitausgedruckt auf Seite1.
Bei meinen Versuchen wird sie mitgedruckt, allerdings klafft eine Lücke zwischen ihr und dem rechten Rand und das liegt eindeutig daran, daß ich Columnwidth nicht genauer steuern kann.
Mein Grundgedanke ist/war, ich will z.B 16 oder 18 Spalten haben mit jeweils 1cm Breite. In Schleifen erhöhe ich die Einzelbreiten um 1 bis die Anzahl der Druckseiten sich um 1 erhöht, auslesbar mit dem Excel4-Ding oder mit dem Vertikalcheck.
Dann minimiere ich wieder um 1 um dann das gleiche Spiele mit .01 zu machen, dann mit 0.001 usw.
Ergebnis ist leider, daß zwischen der letzten Zelle und dem rechten Rand eine Lücke ist.
Und ich hatte auch andere Versuche, wo ich per Kamera ein Bild von A1:stuck_out_tongue:12 machte und dieses Bild dann schrittweise in der Breite erhöhte, gleiches Ergebnis 
Sorry für den langen Text, ich hoffe du konntest meinen Zickzackerklärungsversuchen folgen 
Gruß
Reinhard
Es geht um Prozedur „tta“
Option Explicit
'
Sub tta()
Dim s As Byte, sw As VPageBreak, cPartial As Byte, n As Single, a
ActiveSheet.PageSetup.LeftMargin = Application.CentimetersToPoints(2#)
ActiveSheet.PageSetup.RightMargin = Application.CentimetersToPoints(3#)
n = 2
For s = 1 To 16
Cells(1, s) = Chr(64 + s)
Cells(1, s).ColumnWidth = n
Next s
For a = 0 To 5
While cPartial = 0
n = n + 10 ^ -a
For s = 1 To 16
Cells(1, s).ColumnWidth = n
Next s
ActiveSheet.PageSetup.PrintArea = "$A$1:blush:P$3"
Application.ScreenUpdating = True
For Each sw In Worksheets(1).VPageBreaks
If sw.Extent = xlPageBreakPartial Then cPartial = cPartial + 1
Next
Wend
cPartial = 0
n = n - 10 ^ -a
For s = 1 To 16
Cells(1, s).ColumnWidth = n
Next s
Next a
For s = 1 To 16 Step 2 'Kleiner Pfusch :smile:
Cells(1, s).ColumnWidth = Cells(1, s).ColumnWidth + 0.2
Next s
ActiveSheet.PrintPreview
'MsgBox n / 16
End Sub
'
Function Vertikalcheck()
Dim raZelle As Range
Vertikalcheck = 0
On Error GoTo Fehler
Set raZelle = Rows(1).Find("R")
MsgBox raZelle.Address
Vertikalcheck = Int(raZelle.Column / ActiveSheet.VPageBreaks(1).Location.Column)
Fehler:
End Function
'
Sub ttb()
Dim n As Single, s, b As Single
For s = 1 To 18
Cells(1, s) = Chr(64 + s)
Cells(1, s).ColumnWidth = 2
Next s
While ExecuteExcel4Macro("GET.Document(50)")