per Makro Tabellenblatt drucken

Sub aktivesBlattToPdf() ChDir "D:\Temp\" 'anpassen 'oder thisworkbook.path ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Range("G41").Value & Format(Date, "YYYYMMDD") & ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Analysedrucken() ChDir "D:\Temp\" 'anpassen 'oder thisworkbook.path Worksheets("Analyse NEU").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Range("G41").Value & Format(Date, "YYYYMMDD") & ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False End Sub

Sub Analysedrucken() ChDir "D:\Temp\" 'anpassen 'oder thisworkbook.path With Worksheets("Analyse NEU") .ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=.Range("G41").Value & Format(Date, "YYYYMMDD") & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False End With End Sub

Hallo Sepp,
versuche ich gerne.
Im Tabellenblatt "aktuelle Liste" stehen Basisdaten die per Makro ( CommandButton 1 - CommandButton210 ) an das Tabellenblatt "Analyse Neu" gesandt werden. Sprich, jede Zeile in "aktuelle Liste" hat einen Button um die Werte zu übergeben. Im Anschluss würde ich das von dir und Hajo korrigierte MArko verwenden um einen PDF Druck zu erzeugen. In der jetzigen Situation müsste der Anwender der Datei je Zeile 2 Buttons klicken um für eine Zeile einen PDF Druck zu erhalten. Das darf auch gerne so sein um eine gezielte Auswahl zu ermöglichen. Durchaus könnte es aber sein das sich jemand sagt, erstelle mir von allen EInträgen je eine PDF Datei. Derzeit hat meine Liste 210 Zeilen die jeweils in eine PDF Datei gegeben werden könnte. In Summe müsste man also um je Zeile eine PDF zu bekommen 420 mal klicken um die derzeit vorhandnen Zeilen in je eine PDF zu bekommen.
Ich beschreibe es mal laienhaft in meinen Worten was Excel machen sollte:
1. Klick CommandButton1
2. Auführen PDF Druck
3. Klick CommandButton2
4. Auführen PDF Druck1
5. Klick CommandButton3
6. Auführen PDF Druck
usw.....
ICh hoffe es war so verständlich .....so etwas lässt sich ja leider nicht aufzeichen. Der Anfang würde mir logischerweise genügen ....
VG
Michael

Hallo Sepp,
zum Daten übergeben verwende ich folgende Code´s ( mit Rekorder ausgezeichnet )

Private Sub CommandButton21_Click()
Rows("5:5").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton210_Click()
Rows("14:14").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton211_Click()
Rows("15:15").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton212_Click()
Rows("16:16").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton213_Click()
Rows("17:17").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton214_Click()
Rows("18:18").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton215_Click()
Rows("19:19").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton216_Click()
Rows("20:20").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton217_Click()
Rows("21:21").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton218_Click()
Rows("22:22").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton219_Click()
Rows("23:23").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton22_Click()
Rows("6:6").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton220_Click()
Rows("24:24").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton221_Click()
Rows("25:25").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton222_Click()
Rows("26:26").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton223_Click()
Rows("27:27").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton224_Click()
Rows("28:28").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton225_Click()
Rows("29:29").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton226_Click()
Rows("30:30").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton227_Click()
Rows("31:31").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton228_Click()
Rows("32:32").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton229_Click()
Rows("33:33").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton23_Click()
Rows("7:7").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton230_Click()
Rows("34:34").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton231_Click()
Rows("35:35").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton232_Click()
Rows("36:36").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton233_Click()
Rows("37:37").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton234_Click()
Rows("38:38").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton235_Click()
Rows("39:39").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton236_Click()
Sheets("Analyse NEU").Select
End Sub

Private Sub CommandButton24_Click()
Rows("8:8").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton25_Click()
Rows("9:9").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton26_Click()
Rows("10:10").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton27_Click()
Rows("11:11").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton28_Click()
Rows("12:12").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Private Sub CommandButton29_Click()
Rows("13:13").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Die Zeile 1 spiegelt dann die Daten die ich genötige nach "Analyse NEU"....
VG
Michael

' ********************************************************************** ' Modul: Modul1 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub printAll() Dim lngIndex As Long, objSource As Worksheet, objPrint As Worksheet On Error GoTo ErrorHandler With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With ChDir "D:\Temp\" 'anpassen 'oder thisworkbook.path Set objSource = Sheets("aktuelle Liste") Set objPrint = Sheets("Analyse NEU") With objSource For lngIndex = 5 To Application.Max(5, .Cells(.Rows.Count, 1).End(xlUp).Row) .Rows(lngIndex).Copy .Range("A1") objPrint.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=objPrint.Range("G41").Value & Format(Date, "YYYYMMDD") & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False Sleep 250 Next End With ErrorHandler: If Err.Number <> 0 Then MsgBox "Fehler in Modul1" & vbLf & vbLf & "Prozedur:" & vbTab & "printAll" & vbLf & _ "Nummer:" & vbTab & Err.Number & vbLf & "Meldung:" & vbTab & Err.Description & vbLf & _ IIf(Erl, "Zeile:" & vbTab & Erl, ""), vbExclamation, "Fehler!" Err.Clear End If With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With Set objSource = Nothing Set objPrint = Nothing End Sub

' ********************************************************************** ' Modul: Modul5 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub printAll() Dim lngIndex As Long, objSource As Worksheet, objPrint As Worksheet On Error GoTo ErrorHandler With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With ChDir "D:\Temp\" 'anpassen 'oder thisworkbook.path Set objSource = Sheets("aktuelle Liste") Set objPrint = Sheets("Analyse NEU") With objSource For lngIndex = 5 To Application.Max(5, .Cells(.Rows.Count, 2).End(xlUp).Row) .Rows(1) = .Rows(lngIndex).Value objPrint.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=objPrint.Range("G41").Value & Format(Date, "YYYYMMDD") & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False Sleep 250 Next End With ErrorHandler: If Err.Number <> 0 Then MsgBox "Fehler in Modul1" & vbLf & vbLf & "Prozedur:" & vbTab & "printAll" & vbLf & _ "Nummer:" & vbTab & Err.Number & vbLf & "Meldung:" & vbTab & Err.Description & vbLf & _ IIf(Erl, "Zeile:" & vbTab & Erl, ""), vbExclamation, "Fehler!" Err.Clear End If With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With Set objSource = Nothing Set objPrint = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

25
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

per Makro Tabellenblatt drucken

25 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

25
Beiträge zum Forumthread

Beiträge zu diesem Forumthread