AW: Tabelle Drucken ohne Rahmen
K.Rola
...noch ein wenig kürzer:
Option Explicit
Sub Rahmen_weg()
Const R As Long = -4142
With Selection
.Borders.LineStyle = R
.Borders(5).LineStyle = R
.Borders(6).LineStyle = R
End With
End Sub
Gruß K.Rola
Hallo,
Echt super!!! Es ist perfekt
aber nur für erste schritt da diese Makro Formatierung löscht und nicht wider herstellt. Währe denkbar nach gedruckten Formblatt das Urschprungliches zustand wiederhergestellt wird? Da dieser gleichen Formblatt immer wider hergenommen wird mit anderen Inhalt ausgefühlt und gedruckt.
Danke vielmals!!!
Hi Metin,
probiers mal so:
Option Base 1
Dim Rahmen(8, 1)
Sub Makro1()
Dim Linien
Linien = Array(xlDiagonalDown, xlDiagonalUp, xlEdgeLeft, xlEdgeTop, _
xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
For n = 1 To 8
Call MerkenLöschen(n, Linien(n))
Next n
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
For n = 1 To 8
Call Zeichnen(n, Linien(n))
Next n
End Sub
Sub MerkenLöschen(ByVal nr As Integer, ByVal welche As Integer)
Set ww = ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
With ww.Borders(welche)
Rahmen(nr, 1) = .LineStyle
.LineStyle = -4142
End With
End Sub
Sub Zeichnen(ByVal nr As Integer, ByVal welche As Integer)
Set ww = ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
With ww.Borders(welche)
.LineStyle = Rahmen(nr, 1)
End With
End Sub
Gruß
Reinhard
Hallo Reinhard,
Echt super!!! Es ist perfekt
genau was ich gesucht habe...
Danke vielmals!!!
MfG Metin
Hallo Reinhard,
Sorry! Ich habe mich zu früh gefreut. Kann es sein das ich irgendwie Fehler mache da die Makro ganzen befehle erledigt aber Wiederherstellung von gelöschten rahmen nicht tuet?
MfG Metin
Hi Melin,
beim Testen bei mir klappts fehlerfrei. (Fehler kommt nur wenn man noch keinen Druckbereich definiert hat). Rahmen werden entfernt, es wird gedruckt, dann sind sie wieder da.
Lade doch mal eine kleine Beispieldatei hoch wo es bei dir nicht klappt.
Gruß
Reinhard
Hallo Reinhard,
Ich hoffe klappt es mit Datei hoch laden und tausend dank für deine geduld und Hilfe.
MfG Metin
https://www.herber.de/bbs/user/11418.xls
Hi Melin,
bei deiner Datei hat das Makro gefehlt, aber kein Problem, ich hatte es ja.
In https://www.herber.de/bbs/user/11422.xls
siehst du in Tabelle2 warum ich derzeit nicht durchblicke.
Da ist auch ein Druckbereich mit Rahmen innen aussen,sogar quer, da klappt es problemlos nacheinander, in Tabelle1 klappt es nicht=Rahmen sind nachher weg und beide Male wird das gleiche Makro genommen *grübel*
Arbeitshyphotese: In Tabelle1 werden andere Linien als in Tabelle2 benutzt, vielleicht mmuss man was anderes als linsstyle sichern. Naja, wenig Sinn *g
Naja vielleicht kommen wir beide mal auf die Lösung oder K.Rola schaut noch rein *hoff*
Gruß
Reinhard
Nochmal der Code für Interessierte:
Option Base 1
Dim Rahmen(8, 1)
Sub Makro1()
Dim Linien
Linien = Array(xlDiagonalDown, xlDiagonalUp, xlEdgeLeft, xlEdgeTop, _
xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
For n = 1 To 8
Call MerkenLöschen(n, Linien(n))
Next n
ActiveWindow.SelectedSheets.PrintPreview
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
For n = 1 To 8
Call Zeichnen(n, Linien(n))
Next n
End Sub
Sub MerkenLöschen(ByVal nr As Integer, ByVal welche As Integer)
Set ww = ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
With ww.Borders(welche)
Rahmen(nr, 1) = .LineStyle
.LineStyle = -4142
End With
End Sub
Sub Zeichnen(ByVal nr As Integer, ByVal welche As Integer)
Set ww = ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
With ww.Borders(welche)
.LineStyle = Rahmen(nr, 1)
End With
End Sub
ot
Hallo Reinhardt,
Ich möchte gerne mit Excel erstellter Tabelle (Formblatt) ohne rahmen, Zellen Umrandungen und auch ohne Farben drucken. Hintergrund ist: ich habe tausende vorgefertigte Formblatts die nur in einige leeren Zellen nochmall beschriftet und gedruckt werden. Dabei soll es die genante Tabelle immer auf den Monitor unverändert bleiben. Diesen Formblatts sind auch mit Excel gefertigt und wegen kosten gründen vom externen Druckerei gedruckt. Ich Danke dir und alle anderen die für meine Problem lösungs- gesucht haben.
MfG
Metin