Moin,
[quote]1. wie füge ich das Makro in eine Arbeitsmappe ein und kann ich es
dann über eine Schaltfläche starten?[/quote]
Den Code aus der Beispielmappe wuerde ich nicht in eine andere Mappe einfuegen. Er loescht ja schliesslich in der Mappe, in der er laeuft, alle Tabellen, ausser jene die "Drucken" heisst. Daher habe ich das mal entsprechend umgebaut (siehe weiter unten). In der umgebauten Version wird neben den zu druckenden auch noch eine NEUE Mappe geoeffnet, in der die einzelnen Tabellen zusammengefasst werden. Alle 3 Mappen werden nach dem Druck derzeit OHNE SPEICHERN oder Rueckfrage geschlossen. Der Code gehoert dann nun in ein Standard-Modul. Eine Anleitung dazu findest Du unter [b][url]
http://www.excelbeispiele.de/[/url][/b] -> [b]Anleitungen[/b]-> [b]3.) Anleitung zum VBA Projekt “StandardModul"[/b].
Um das Ganze dann ueber eine Befehlsschaltflaeche zu starten folge einfach der Anleitung [b]4.) Anleitung zum Einfügen einer Befehlsschaltfläche [/b] auf der selben Site.
[quote]2. gibt es noch eine Ergänzung so das ich in allen ausgedruckten
Tabellen in die Zelle C4 meinen Vornamen einfügen kann[/quote]
Das habe ich in den unten gelisteten Code gleich einmal mit eingebaut. Du musst dann nur im Code in der Zeile mit [i]...Range("C4").Value = "Vorname"[/i] das [i]Vorname[/i] durch Deinen eigenen Namen/Text ersetzen. (AnfuehrungsZeichen muessen bleiben.)
Code fuer das StandardModul waere dann:[code]
Sub MappenDruck()
'VariablenDefinition
'===================
Dim strPathFF As String, strPathSF As String
Dim dlgFilePicker As FileDialog
Dim wbFF As Workbook, wbSF As Workbook, wbPrint As Workbook
Dim intMaxWS As Integer, intCounter As Integer
Dim varArr As Variant
'Dialoge zur Dateiauswahl
'========================
Set dlgFilePicker = Application.FileDialog(msoFileDialogFilePicker)
With dlgFilePicker
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Exceldateien *.xls* ", "*.xls*", 1
.InitialView = msoFileDialogViewDetails
.ButtonName = "erste Datei waehlen"
.Title = " erste zu druckende Datei auswaehlen"
.Show
If .SelectedItems.Count > 0 Then
strPathFF = .SelectedItems(1)
Else
MsgBox "Abbruch": End
End If
End With
With dlgFilePicker
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Exceldateien *.xls* ", "*.xls*", 1
.InitialView = msoFileDialogViewDetails
.ButtonName = "zweite Datei waehlen"
.Title = " zweite zu druckende Datei auswaehlen"
.Show
If .SelectedItems.Count > 0 Then
strPathSF = .SelectedItems(1)
Else
MsgBox "Abbruch": End
End If
End With
'Mappen zusammenfuehren
'======================
Set wbPrint = Workbooks.Add(xlWBATWorksheet) 'Druckmappe fuer die Zusammenfassung
Set wbFF = Workbooks.Open(strPathFF) 'erste zu druckende Mappe oeffnen
Set wbSF = Workbooks.Open(strPathSF) 'zweite zu druckende Mappe oeffnen
intMaxWS = wbFF.Sheets.Count 'SheetZahl von erster Mappe
If wbSF.Sheets.Count < wbFF.Sheets.Count Then intMaxWS = wbSF.Sheets.Count 'intMaxWS auf kleinste SheetZahl
For intCounter = 1 To intMaxWS Step 1 'Sheets in Zusammenfassung kopieren
wbFF.Sheets(intCounter).Copy After:=wbPrint.Sheets(wbPrint.Sheets.Count)
wbSF.Sheets(intCounter).Copy After:=wbPrint.Sheets(wbPrint.Sheets.Count)
Next intCounter
ReDim varArr(2 To wbPrint.Sheets.Count) 'Array fuer Namen derzu druckenden Sheets
For intCounter = 2 To wbPrint.Sheets.Count 'Sheets durchlaufen (2 bis Ende)
varArr(intCounter) = wbPrint.Sheets(intCounter).Name 'SheetNamen aufsammeln
If wbPrint.Sheets(intCounter).Type = xlWorksheet Then _
wbPrint.Sheets(intCounter).Range("C4").Value = "Vorname" 'zu druckenden Namen schreiben !ANPASSEN!
Next intCounter
wbPrint.Sheets(varArr).PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False 'Drucken
'Alle Mappen schliessen (OHNE SPEICHERN)
'======================================
wbFF.Close False
wbSF.Close False
wbPrint.Close False
'Objecte zerstoeren
'==================
Set wbPrint = Nothing
Set wbFF = Nothing
Set wbSF = Nothing
Set dlgFilePicker = Nothing
End Sub
[/code]
Cu TheBlackBird ®
