Supportnet / Forum / Tabellenkalkulation
Die Seiteneinrichtung übernehmen
Frage
Hallo,
Ich brauch mal wieder Eure Hilfe!!
ich kopiere mit Hilfe eines VBA Codes den kompletten Inhalt von einer Tabelle in eine neue Tabelle. Wie kann man das so einrichten, das die Seitenrandeinstellung von der Ursprungstabelle automatisch mit übernommen wird??
Vielen Dank!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Gruß
Elhamplo
Antwort 1 von Pistenschreck
Hi Elhamplo
Zeichne mit dem Macrorecorder die Seiteneinrichtung auf.
Am Ende Deines Kopiermakros gibst Du den Link zum Aufgezeichneten.
Das würde in etwa so aussehen ......
Sub KOPIEREN()
Tabelle1.Select
Tabelle1.[A1:F38].Copy Tabelle2.[A1]
Tabelle2.Select
EINGERICHTET_SEITE1
End Sub
Sub EINGERICHTET_SEITE1()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 1200
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
End Sub
Gruss Werner
Zeichne mit dem Macrorecorder die Seiteneinrichtung auf.
Am Ende Deines Kopiermakros gibst Du den Link zum Aufgezeichneten.
Das würde in etwa so aussehen ......
Sub KOPIEREN()
Tabelle1.Select
Tabelle1.[A1:F38].Copy Tabelle2.[A1]
Tabelle2.Select
EINGERICHTET_SEITE1
End Sub
Sub EINGERICHTET_SEITE1()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 1200
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
End Sub
Gruss Werner
Antwort 2 von nighty
hi all :)
ein ansatz :)
gruss nighty
Sub Makro1()
Dim linksVar As Long
Dim rechtsVar As Long
With Worksheets(1).PageSetup
linksVar = .LeftMargin
rechtsVar = .RightMargin
End With
With Worksheets(2).PageSetup
.LeftMargin = linksVar
.RightMargin = rechtsVar
End With
End Sub
ein ansatz :)
gruss nighty
Sub Makro1()
Dim linksVar As Long
Dim rechtsVar As Long
With Worksheets(1).PageSetup
linksVar = .LeftMargin
rechtsVar = .RightMargin
End With
With Worksheets(2).PageSetup
.LeftMargin = linksVar
.RightMargin = rechtsVar
End With
End Sub
Antwort 3 von Elhamplo
Hallo,
sorry, dads ich mich erst jetzt melde. Hab das mal versucht aber das klappt nicht mit meinen Makro.
Hier mal mei Makro:
Sub Kopieren_PDF()
Dim ws As Integer, i As Integer, Ziel As String, Quelle As String
Quelle = ActiveWorkbook.Name
Workbooks.Add
i = 1
For ws = 2 To Workbooks(Quelle).Worksheets.Count
Ziel = ActiveWorkbook.Name
Workbooks(Ziel).Sheets.Add after:=Worksheets(Worksheets.Count)
If Workbooks(Quelle).Sheets(ws).Range("A3") <> "" Then
i = i + 1
End If
Next
Application.ActivePrinter = "PDFCreator auf Ne01:"
Workbooks(Ziel).PrintOut Copies:=1, ActivePrinter:="PDFCreator auf Ne01:", _
Collate:=True
Application.DisplayAlerts = False
Workbooks(Ziel).Close
Application.DisplayAlerts = True
End Sub
Der Makro kopiert nur die Tabellenblätter wo in Zeile A3 nicht leer ist in ein neues Tabellenblatt. Somit können das immer unterschiedlich viele Tabellenblätter sein. Danach sollen die Kopierten Tabellenblätter in ein PDF umgeandelt werden.
Jetzt hier das Problem, das er die Seiteneinrichtung (Ränder) nicht übernimmt. Hab Eure Codes auch mit eingefügt, aber leider hat das nicht so hingehauen.
Habt Ihr noch ein Tip??
Vielen Dank für Eure Mühe!!!
Gruß
Elhamplo
sorry, dads ich mich erst jetzt melde. Hab das mal versucht aber das klappt nicht mit meinen Makro.
Hier mal mei Makro:
Sub Kopieren_PDF()
Dim ws As Integer, i As Integer, Ziel As String, Quelle As String
Quelle = ActiveWorkbook.Name
Workbooks.Add
i = 1
For ws = 2 To Workbooks(Quelle).Worksheets.Count
Ziel = ActiveWorkbook.Name
Workbooks(Ziel).Sheets.Add after:=Worksheets(Worksheets.Count)
If Workbooks(Quelle).Sheets(ws).Range("A3") <> "" Then
i = i + 1
End If
Next
Application.ActivePrinter = "PDFCreator auf Ne01:"
Workbooks(Ziel).PrintOut Copies:=1, ActivePrinter:="PDFCreator auf Ne01:", _
Collate:=True
Application.DisplayAlerts = False
Workbooks(Ziel).Close
Application.DisplayAlerts = True
End Sub
Der Makro kopiert nur die Tabellenblätter wo in Zeile A3 nicht leer ist in ein neues Tabellenblatt. Somit können das immer unterschiedlich viele Tabellenblätter sein. Danach sollen die Kopierten Tabellenblätter in ein PDF umgeandelt werden.
Jetzt hier das Problem, das er die Seiteneinrichtung (Ränder) nicht übernimmt. Hab Eure Codes auch mit eingefügt, aber leider hat das nicht so hingehauen.
Habt Ihr noch ein Tip??
Vielen Dank für Eure Mühe!!!
Gruß
Elhamplo
Antwort 4 von nok106
Hallo Excelfreunde !
Gibt es hierfür auch eine Lösung ?
Die Zeilen und Spaltenbreiten Einstellungen mit
im Makro zu übernehmen.
Hat jemand eine Idee ob das geht und wenn ja - Wie ?
Einstweilen herzlichen Dank an alle, die sich für mich bemühen.
MfG Odje
Gibt es hierfür auch eine Lösung ?
Die Zeilen und Spaltenbreiten Einstellungen mit
im Makro zu übernehmen.
Zitat:
REM Die Seiteneinrichtung übernehmen
Sub KOPIEREN()
Tabelle16.Select
Tabelle1.[A1:O30].Copy Tabelle17.[A1]
Tabelle17.Select
Dim obenVar As Long
Dim untenVar As Long
Dim linksVar As Long
Dim rechtsVar As Long
With Worksheets(16).PageSetup
obenVar = .TopMargin
untenVar = .BottomMargin
linksVar = .LeftMargin
rechtsVar = .RightMargin
End With
With Worksheets(17).PageSetup
.TopMargin = obenVar
.BottomMargin = untenVar
.LeftMargin = linksVar
.RightMargin = rechtsVar
End With
End Sub
REM Die Seiteneinrichtung übernehmen
Sub KOPIEREN()
Tabelle16.Select
Tabelle1.[A1:O30].Copy Tabelle17.[A1]
Tabelle17.Select
Dim obenVar As Long
Dim untenVar As Long
Dim linksVar As Long
Dim rechtsVar As Long
With Worksheets(16).PageSetup
obenVar = .TopMargin
untenVar = .BottomMargin
linksVar = .LeftMargin
rechtsVar = .RightMargin
End With
With Worksheets(17).PageSetup
.TopMargin = obenVar
.BottomMargin = untenVar
.LeftMargin = linksVar
.RightMargin = rechtsVar
End With
End Sub
Hat jemand eine Idee ob das geht und wenn ja - Wie ?
Einstweilen herzlichen Dank an alle, die sich für mich bemühen.
MfG Odje