mehrere blätter selektieren,hilfeeeeeee!!!!!!!!!
02.09.2007 00:25:39
minoucha
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