Mehrere Dateien erstellen

Hallo...
ich stehe vor einem Problem:
ich habe eine Tabelle Importliste, hier werden immer wieder neue Daten in einer Zeile eingetragen; umfasst jetzt ca 920 Zeilen mit Zellen von A bis AJ
in einer anderen Tabelle "Formular" in der selben Arbeitsmappe ist eine Art Formular, wo ich über einen SVerweis die Daten aus der Tabelle "Importliste" hole, das funktioniert auch alles;
hier sind zwei Button, die per Makro einmal ein PDF erzeugen und auch speichern mit einem Namen aus einer Zelle aus dem Formular und es wird eine neue Arbeitsmappe mit nur dem Formular erzeugt und diese auch mit dem Namen abgespeichert.
das funktioniert alles
jetzt mein Problem:
es sollen jetzt alle Formulare als PDF und Excel-Arbeitsmappe gespeichert werden, mit Namen, automatisch(MAKRO) wobei die Daten über die Importliste per SVerweis eingelesen werden
also kurz: ich suche mir einen Bereich aus: von 100 bis 200 (aus der Importliste, sind techn. Nr.)und jetzt sollen die PDF; Excel-mappen gespeichert werden usw...
als Schmankel sollen auch neue Daten erfasst werden können un der Bereich automatisch vergrössert wird...
ich hoffe, man kann mit dieser Erläuterung etwas anfangen...

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub PDFerstellen() ' Dateiname ist Datum aus "B49" 'strPath As String strPath = Range("B51") ' MsgBox ist eine optionale Komponente ' Rückfragen, ob Datei nach dem Erstellen geöffnet werden soll If MsgBox("Soll die PDF-Datei nach dem Erstellen angezeigt werden?", vbYesNo, "PDF anzeigen? ") = vbYes Then pdfOpenAfterPublish = True ' Vorgaben zum speichern des Dokuments ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPath & Range("B49").Value & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=IIf(pdfOpenAfterPublish, True, False) '(in Kombination mit MsgBox) ' OpenAfterPublish = True (wenn keine MsgBox gewünscht ist) End Sub

Hallo
mir ist aufgefallen, dass Dateien dann mehrfach erzeugt werden. Z.B. 104
Das solltest du prüfen
Hier der geänderte Code


Option Explicit
Public TMP As Boolean
Sub Automatisch()
Dim Von As Variant, Bis As Variant, ZVon As Integer, ZBis As Integer
Dim TB1 As Worksheet, TB3 As Worksheet
Dim Zeile As Range, SpID As Integer, i As Integer
Set TB1 = Sheets("Importliste")
Set TB3 = Sheets("Formular")
SpID = 6 'ID in Spalte F
Set Zeile = TB3.Range("C8")
Von = InputBox("Automatisch drucken Von", "Eingabe", 100)  'Beispiel
Bis = InputBox("Automatisch drucken Bis", "Eingabe", 200)
If Not IsNumeric(Von) Or Not IsNumeric(Bis) Then
MsgBox "Fehler bei Eingabe"
Exit Sub
End If
TMP = True 'Bei automatisch keine Msgbox
ZVon = WorksheetFunction.CountIf(TB1.Columns(SpID), Format(Von, "0000"))
If ZVon > 0 Then
ZVon = WorksheetFunction.Match(Format(Von, "0000"), TB1.Columns(SpID), 0)
Else
MsgBox Von & ": nicht gefunden"
Exit Sub
End If
ZBis = WorksheetFunction.CountIf(TB1.Columns(SpID), Format(Bis, "0000"))
If ZBis > 0 Then
ZBis = WorksheetFunction.Match(Format(Bis, "0000"), TB1.Columns(SpID), 0)
Else
MsgBox Bis & ": nicht gefunden"
Exit Sub
End If
For i = ZVon To ZBis
Zeile = TB1.Cells(i, 1) ' Zeile aus A für Sverweis wird gesetzt
Call PDFerstellen
Call Blattspeichern
Next
TMP=False
End Sub
Sub PDFerstellen() ' Dateiname ist Datum aus "B49"
Dim strPath As String, pdfOpenAfterPublish As Boolean
strPath = Range("B51")
If Not TMP Then
'   MsgBox ist eine optionale Komponente
'   Rückfragen, ob Datei nach dem Erstellen geöffnet werden soll
If MsgBox("Soll die PDF-Datei nach dem Erstellen angezeigt werden?", vbYesNo, "PDF anzeigen? ") = vbYes Then pdfOpenAfterPublish = True
'   Vorgaben zum speichern des Dokuments
Else
pdfOpenAfterPublish = False
End If
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPath & Range("B49").Value & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=IIf(pdfOpenAfterPublish, True, False)         '(in Kombination mit MsgBox)
'OpenAfterPublish = True  (wenn keine MsgBox gewünscht ist)
End Sub

und


Sub Blattspeichern()
Application.ScreenUpdating = False
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Range("B50") & Range("B49") & ".xls"
ActiveWorkbook.Close
End Sub

LG UweD

' IncludeDocProperties = True >> Dokumenteigenschaften werden eingeschlossen ' IgnorePrintAreas = False >> festgelegte Druckbereiche werden übernommen ' OpenAfterPublish = True >> Dokument wird nach dem speichern nochmal angezeigt Option Explicit Public TMP As Boolean Sub Automatisch() Dim RNG As Range, Z Dim TB1 As Worksheet, TB3 As Worksheet Dim Zeile As Range, Sp As Integer, i As Integer Set TB1 = Sheets("Importliste") Set TB3 = Sheets("Formular") Sp = 7 'Auswahlspalte G Set Zeile = TB3.Range("C8") 'Bereich auswählen TB1.Activate Set RNG = Application.InputBox("Automatisch drucken Von/Bis markieren", Type:=8) 'Beispiel TB3.Activate If RNG Is Nothing Or RNG.Columns.Count > 1 Or RNG.Column Sp Then MsgBox "unzulässiger Auswahl" Exit Sub End If TMP = True 'Bei automatisch keine Msgbox For Each Z In RNG Zeile = Z.Offset(0, -Sp + 1) ' Zeile aus A für Sverweis wird gesetzt Call PDFerstellen Call Blattspeichern Next TMP = False End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mehrere Dateien erstellen

8 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)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread