Hallo ihr Profis,
hab mal wieder ein kleines Problem:
Ich habe eine Rechnungsvorlage (mit Farbe, Grafik usw.) als Tabellenblatt.
Gedruckt werden sollte es ohne Grafik usw.
Ich erstelle jetzt mit einem Makro ein neues Tabellenblatt kopiere die Daten, übernehme die Zellenhöhe-breite.
Sollange die Arbeitsmappe nicht für mehrere Benutzer über das Netzwerk frei gegeben ist geht alles wunderbar.
Gebe ich die Datei frei wird mir das Tabellenblatt nicht mehr gelöscht.
Auch werden die Zellenhöhe-Breite nicht übenommen.
Ich hänge mal den Code an. Der Aufruf für das Makro schutzein bzw. schutzaus läuft ins leere. Da dies bei einer freigegebenen Datei je auch nicht geht.
Danke euch jetzt schon mal.
Gruß
Oswald
f~
UserForm1.Show vbModeless 'Bitte warten anzeigen
DoEvents 'bewirkt das nicht nur die Kopfzeile angezeigt wird
Application.ScreenUpdating = False
'Abfrage ob Beidseitig schon vorhanden, wenn ja dann löschen
Dim ws As Object
For Each ws In Worksheets
If ws.name = "Drucken" Then GoTo loeschen
Next
GoTo weiter
loeschen:
'Abfrage ob es Beidseitig gibt
For Each ws In Worksheets
If (ws.name = "Drucken") Then GoTo loeschen2
Next
loeschen2:
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Drucken").Delete
Application.DisplayAlerts = True
weiter:
'Druckerauswahlfenster anzeigen und abfangen wenn Abrechen angeklickt wird
Dim r1 As Integer
r1 = Application.Dialogs(xlDialogPrinterSetup).Show
If r1 = 0 Then GoTo ende
Dim tabname As String
'extra Tabellenblatt einfügen
Worksheets.Add after:=Sheets("Rechn. suchen Verbr.")
tabname = "Drucken"
ActiveSheet.name = tabname
'Seitenränder setzen
With Worksheets("Drucken").PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
End With
'Daten kopieren und einfügen
'Workbooks("Blanko").Activate
ActiveWorkbook.Worksheets("Blanko").Activate
Range("A1:I57").Copy
'Spaltenbreite / Zeilenhöhe ermitteln
Dim x As Integer, z As Integer
Dim y(9) As Single 'bis 48 Vorderseite, dann Rückseite
Dim w(57) As Single 'bis 50 Vorderseite, dann Rückseite
'Spalten
For z = 1 To 9
y(z) = Worksheets("Blanko").Columns(z).ColumnWidth
Next z
'Zeilen
For x = 1 To 57
w(x) = Worksheets("Blanko").Rows(x).RowHeight
Next x
'Spaltenbreite / Zeilenhöhe zuweisen
'Spalten
For z = 1 To 9
Worksheets("Drucken").Columns(z).ColumnWidth = y(z)
Next z
'Zeilen
For x = 1 To 57
Worksheets("Drucken").Rows(x).RowHeight = w(x)
Next x
'Daten einfügen
ActiveWorkbook.Worksheets("Drucken").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlPasteFormats
'Selection.PasteSpecial Paste:=xlPasteColumnWidths
Application.CutCopyMode = False
'Felder löschen
Range("E12:I19").Clear
Range("A56:I57").Clear
'graue Felder zurücksetzen
Range("A1:I57").Cells.Interior.ColorIndex = -4142
'Druckbereich festlegen
Worksheets("Drucken").PageSetup.PrintArea = "$A$1:$I$57"
'Seitenumbruch festlegen
Range("J58").Select
ActiveSheet.PageSetup.Zoom = 91 'Seitenskalierung auf 92% setzten
ActiveSheet.HPageBreaks.Add Before:=ActiveCell 'Seitenumbruch setzten
ActiveSheet.VPageBreaks.Add Before:=ActiveCell 'Seitenumbruch setzten
'Datum fett formatieren
Worksheets("Drucken").Range("A53").Value = "Diese Rechnung wird fällig am " & Worksheets("Blanko").Range("A179")
If Worksheets("Blanko").Range("A179") "" Then Worksheets("Drucken").Range("A53").Characters(Start:=30, Length:=11).Font.Bold = True
'Ausdrucken
ActiveWorkbook.Worksheets("Drucken").PrintOut
'löschen
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Drucken").Delete
Application.DisplayAlerts = True
Worksheets("Blanko").Activate
ende:
Unload UserForm1
Call SchutzEin 'Blattschutz ein
End Sub
f~