mehrere blätter selektieren,hilfeeeeeee!!!!!!!!!

Forumthread: mehrere blätter selektieren,hilfeeeeeee!!!!!!!!!

02.09.2007 00:25:39

minoucha

Hallo,
Ich habe über 50 blätter die selktiert werden müssen um die zu speichern.
wer kann mir weiterhelfen ?
Also ich möchte noch diese Befehle in makro rein
Code:
If Range("C_Profil_educatin34") = True Then
Worksheets("education34").Select
End If
If Range("C_Profil_education35") = True Then
Worksheets("education35").Select
End If:
die Oben zwei befehle möchte ich in diesem code rein :
dh ich möchte die Blätter "Title .....bis education20"gespeichert werden aber die blätter "education34 "und "education35" hängt vom kunde ab .wenn er educatcation 35 wählt dann:
alle blätter vom (Title....bis education 20)plus blatt (education35) speichern.
Code:


Private Sub Btn_99_Druckausgabe_Speichern_Click()
Dim pfad
Dim FileSaveName 'Pfad und Dateiname der zu sichernden Datei
Dim intCounter As Integer
Dim a As Byte
Dim Blatt As Worksheet
Dim wks As Worksheet
Dim kunde, datum, Name, Firma, Abteilung, Inhalt, Seite, zeile
For Each Blatt In Sheets
Blatt.Visible = True
Next Blatt
'Datum aktualisieren
Range("Z_Datum") = Date
'Date$ liefert MM-TT-YYY. Die Bindestriche müssen raus
datum = Mid(Date$, 7, 4) & Left(Date$, 2) & Mid(Date$, 4, 2)
empfaenger = Range("Z_Titelblatt_Kunde")
pfad = ActiveWorkbook.Path
FileSaveName = Application.GetSaveAsFilename _
(InitialFileName:=pfad & "\Checkliste_" & empfaenger & "_" & datum, _
FileFilter:="EXCEL-Tabelle (*.xls), *.xls ,pdf datei (*.pdf),*.pdf")
If FileSaveName  False Then
Select Case LCase$(Right$(FileSaveName, 3))
Case "xls"
ActiveSheet.SaveAs Filename:=FileSaveName
Case "pdf"
'deine Druckroutine für PDF
ActiveSheet.SaveAs Filename:=FileSaveName
Worksheets(Array("title", "contact", "contact2", "dates", "Type", "education", "education2", " _
education3", "education4", _
"education5", "education6", "education7", "education7", "education8", "education9", " _
education10", _
"education11","education12", "education13", "education14", "education15", "education16", " _
education17", "education18", _
"education19","education20")).Select
Application.Dialogs(xlDialogPrinterSetup).Show
MsgBox Application.ActivePrinter
ActiveWindow.SelectedSheets.PrintOut Copies:=1, printtofile:=True, PrToFileName:= _
InitialFileName, Collate:=True
End Select
End If
On Error Resume Next 'Fehlerausgang, Weiter mit Löschen, wenn EMail abgelehnt wurde
For a = 9 To Sheets.Count 'oder die Zahl bis wohin ausgeblendet werden soll
Sheets(a).Visible = False
Next a
End Sub

Vielen Dank

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: mehrere blätter selektieren,hilfeeeeeee!!!!!!!!!

02.09.2007 09:47:23

Christian

AW: mehrere blätter selektieren,hilfeeeeeee!!!!!!!!!

02.09.2007 09:47:23

Christian

Hallo minoucha,
So wie in deinem Code umgesetzt, kannst du eine Excel-Datei nicht als PDF-Datei speichern.
Dabei wird zwar ein PDF-File erzeugt, dieses lässt sich jedoch nicht mit dem PDF-Reader öffnen.
Du kannst aber eine Excel-Datei als PDF-File drucken (hiezu muss zum Beispiel der "FreePDF XP" als Drucker eingerichtet werden). Dabei wird nicht auf Papier gedruckt, sondern in eine Datei.
Doch zu deiner Frage: "mehrere blätter selektieren":
Schreibe die Namen der Tabellen in ein Array. Erweitere dieses Array um "education34" bzw. "education35" falls die Einträge "true" sind.
Code: (den Teil "speichern als PDF" habe ich nicht weiter angepackt).
Gruß
Christian


Option Explicit
Private Sub Btn_99_Druckausgabe_Speichern_Click()
Dim pfad As String
Dim FileSaveName   'Pfad und Dateiname der zu sichernden Datei
Dim a As Byte
Dim i As Byte
Dim Blatt As Worksheet
Dim wks As Worksheet
Dim datum As String
Dim empfaenger As String
Dim aSheet() As String
For Each Blatt In Sheets
Blatt.Visible = True
Next Blatt
'Datum aktualisieren
Range("Z_Datum") = Date
datum = Format(Date, "YYYYMMDD")
empfaenger = Range("Z_Titelblatt_Kunde")
pfad = ActiveWorkbook.Path
'List of Worksheets:
ReDim aSheet(24)
aSheet(0) = "title"
aSheet(1) = "contact"
aSheet(2) = "contact2"
aSheet(3) = "dates"
aSheet(4) = "Type"
aSheet(5) = "education"
For i = 2 To 20
aSheet(i + 4) = "education" & i
Next
If Range("C_Profil_educatin34") = True Then
ReDim Preserve aSheet(UBound(aSheet) + 1)
aSheet(UBound(aSheet)) = "education34"
End If
If Range("C_Profil_education35") = True Then
ReDim Preserve aSheet(UBound(aSheet) + 1)
aSheet(UBound(aSheet)) = "education35"
End If
FileSaveName = Application.GetSaveAsFilename _
(InitialFileName:=pfad & "\Checkliste_" & empfaenger & "_" & datum, _
FileFilter:="EXCEL-Tabelle (*.xls), *.xls ,pdf datei (*.pdf),*.pdf")
If FileSaveName  False Then
Select Case LCase$(Right$(FileSaveName, 3))
Case "xls"
ActiveSheet.SaveAs Filename:=FileSaveName
Case "pdf"
'deine Druckroutine für PDF
ActiveSheet.SaveAs Filename:=FileSaveName
Worksheets(aSheet).Select
Application.Dialogs(xlDialogPrinterSetup).Show
MsgBox Application.ActivePrinter
ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
printtofile:=True, PrToFileName:=InitialFileName, Collate:=True
End Select
End If
On Error Resume Next   'Fehlerausgang, Weiter mit Löschen, wenn EMail abgelehnt wurde
For a = 9 To Sheets.Count   'oder die Zahl bis wohin ausgeblendet werden soll
Sheets(a).Visible = False
Next a
End Sub

Beliebteste Forumthreads (12 Monate)

mehrere blätter selektieren,hilfeeeeeee!!!!!!!!!

Forumthread: mehrere blätter selektieren,hilfeeeeeee!!!!!!!!!

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread