Seiteneinrichtung im Makro übernehmen

Dieses Thema Seiteneinrichtung im Makro übernehmen im Forum "Microsoft Office Suite" wurde erstellt von nok106, 30. Okt. 2006.

Thema: Seiteneinrichtung im Makro übernehmen Hallo Excelfreunde ! Gibt es hierfür eine Lösung ? Ich möchte die Zeilenhöhen und Spaltenbreiten - Einstellungen,...

  1. Hallo Excelfreunde !

    Gibt es hierfür eine Lösung ?

    Ich möchte die Zeilenhöhen und Spaltenbreiten - Einstellungen, aus der zu kopierenden Tabelle, im Makro mit übernehmen.


    Option Explicit

    Sub Kopieren()
    Dim VarOben As Long
    Dim VarUnten As Long
    Dim VarLinks As Long
    Dim VarRechts As Long
    With Worksheets(16).PageSetup
    VarOben = .TopMargin
    VarUnten = .BottomMargin
    VarLinks = .LeftMargin
    VarRechts = .RightMargin
    .PaperSize = xlPaperA4
    .Orientation = xlPortrait
    End With

    With Worksheets(17).PageSetup
    .TopMargin = VarOben
    .BottomMargin = VarUnten
    .LeftMargin = VarLinks
    .RightMargin = VarRechts
    .PaperSize = xlPaperA4
    '.Orientation = xlPortrait
    .Orientation = xlLandscape
    End With

    Tabelle16.[A1:K39].Copy Tabelle17.[A1]

    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
     
  2. Hallo nok106,

    ich hab dir mal ein Makro zusammengestellt.
    Schau mal, ob es dem entspricht, was du benötigst.

    Gruß Matjes :)
    Code:
    Sub SelektiertenBereichDesAktivesBlattesAufNeuesBlattKopieren()
    '** Der selektierte Bereich eines ArbeitsBlattes wird kopiert
    '** (nur ein Bereich, keine Mehrfachselektion)
    '** Zieladresse der linken Ecke ist A1
    '**
    '** Das Seitenlayout wird übernommen
    '**
    '** Zeilenhöhe und Spaltenbreite werden übernommen
    
     Dim wb As Workbook, ws As Worksheet, ws2 As Worksheet, r As Range
     Dim x As Long, z As Long, sp As Long
     
     Set wb = ActiveWorkbook
     Set ws = ActiveSheet
     Set r = Selection
     
     If ws.Type <> xlWorksheet Then
      MsgBox Aktives Blatt muß Arbeitsblatt sein.
      GoTo AUFRAEUMEN
     End If
     
     If r.Areas.Count > 1 Then
      MsgBox Nur Selektion eines Bereiches zulässig, keine Mehrfach-Selektion.
      GoTo AUFRAEUMEN
     End If
     
    ->neues Blatt anlegen
     Set ws2 = wb.Worksheets.Add(After:=ws)
     
    ->Seitenlayout übernehmen
     With ws.PageSetup
      ws2.PageSetup.BlackAndWhite = .BlackAndWhite
      ws2.PageSetup.BottomMargin = .BottomMargin
      ws2.PageSetup.CenterFooter = .CenterFooter
      ws2.PageSetup.CenterHeader = .CenterHeader
      ws2.PageSetup.CenterHorizontally = .CenterHorizontally
      ws2.PageSetup.CenterVertically = .CenterVertically
      ws2.PageSetup.Draft = .Draft
      ws2.PageSetup.FirstPageNumber = .FirstPageNumber
      ws2.PageSetup.FitToPagesTall = .FitToPagesTall
      ws2.PageSetup.FitToPagesWide = .FitToPagesWide
      ws2.PageSetup.FooterMargin = .FooterMargin
      ws2.PageSetup.HeaderMargin = .HeaderMargin
      ws2.PageSetup.LeftFooter = .LeftFooter
      ws2.PageSetup.LeftHeader = .LeftHeader
      ws2.PageSetup.LeftMargin = .LeftMargin
      ws2.PageSetup.Order = .Order
      ws2.PageSetup.Orientation = .Orientation
      ws2.PageSetup.PaperSize = .PaperSize
     ->** nicht übernehmen, da nur Bereich kopiert wurde
     ->ws2.PageSetup.PrintArea = .PrintArea
      ws2.PageSetup.PrintComments = .PrintComments
      ws2.PageSetup.PrintGridlines = .PrintGridlines
      ws2.PageSetup.PrintHeadings = .PrintHeadings
      ws2.PageSetup.PrintNotes = .PrintNotes
      ws2.PageSetup.PrintQuality = .PrintQuality
      ws2.PageSetup.PrintTitleColumns = .PrintTitleColumns
      ws2.PageSetup.PrintTitleRows = .PrintTitleRows
      ws2.PageSetup.RightFooter = .RightFooter
      ws2.PageSetup.RightHeader = .RightHeader
      ws2.PageSetup.RightMargin = .RightMargin
      ws2.PageSetup.TopMargin = .TopMargin
      ws2.PageSetup.Zoom = .Zoom
     End With
    
    ->selektierten Bereich auf neues Blatt A1 kopieren
     r.Copy ws2.Range(A1)
    
    ->Zeilehöhen übertragen
     z = 0
     For x = r.Row To r.Row + r.Rows.Count - 1
      z = z + 1
      ws2.Rows(z).RowHeight = ws.Rows(x).RowHeight
     Next
     
    ->Spaltenbreiten übertragen
     sp = 0
     For x = r.Column To r.Column + r.Columns.Count - 1
      sp = sp + 1
      ws2.Columns(sp).ColumnWidth = ws.Columns(x).ColumnWidth
     Next
    
    AUFRAEUMEN:
     Set wb = Nothing: Set ws = Nothing: Set ws2 = Nothing: Set r = Nothing
    End Sub
     
  3. Hi Matjes,

    das passt .................. :)

    cool ..!! :1

    Gruß Odje
     
  4. Hab noch eine kleine Korrektur durchgeführt.

    Gruß Matjes :)
     
Die Seite wird geladen...

Seiteneinrichtung im Makro übernehmen - Ähnliche Themen

Forum Datum
Powerpoint und verschiedene Seiteneinrichtungen Microsoft Office Suite 5. Aug. 2005
Excel VBA Makro zum suchen eines Textes und anschließend einen Breich zu kopieren Microsoft Office Suite 22. Jan. 2015
Word 2013 VBA: Makro aus einer anderen Datei aufrufen Microsoft Office Suite 16. Juni 2014
Excel VBA Makro zum suchen und markieren von Zeilen die ein bestimmtes Wort enthalten Microsoft Office Suite 16. Juni 2014
Excel: Makro ASCII verschieben Windows XP Forum 8. Nov. 2013