If Dir ... If Qe ...
Sandra
ich versuche gerade das "PDF_Print_Sheet" zu erweitern/ ergänzen und scheiter mal wieder kläglich.
Im Original sah es mal so aus:
Sub PDF_Print_Sheet()
'Modifiziert
Dim wks As Worksheet
For Each wks In ActiveWindow.SelectedSheets
With wks
.Select
If Dir(Environ("userprofile") & "\Desktop\" & .Name & ".pdf") "" Then
Qe = MsgBox("Die Datei: " & .Name & ".pdf" & vbLf & "ist bereits vorhanden. _
_
" & vbLf & "Soll diese Datei ersetzt werden ?", vbQuestion + vbYesNo, "
ACHTUNG!!")
If Qe = vbNo Then Exit Sub
End If
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Environ("userprofile") & "\Desktop\" & .Name & ".pdf", Quality:=xlQualityStandard, _
_
_
_
_
_
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End With
Next wks
End Sub
Nun wollte ich noch ein paar Ergänzungen einbauen.
1. Wenn die Prüfung ergeben hat, dass die Datei schon vorhanden ist, man sie aber nicht ersetzen möchte, dann soll die MsgBox kommen, in der nach einem Dateinamen gefragt wird.
2. Wenn dort die Namenseingabe abgebrochen wird soll nix passieren, wenn ein name eingegeben wird, dann soll natürlich die Datei unter neuem Namen abgelegt werden.
Das habe ich daraus gemacht:
Sub PDF_Print_Sheet()
'Modifiziert
Dim wks As Worksheet
For Each wks In ActiveWindow.SelectedSheets
With wks
.Select
If Dir(Environ("userprofile") & "\Desktop\" & .Name & ".pdf") "" Then
Qe = MsgBox("Die Datei: " & .Name & ".pdf" & vbLf & "ist bereits vorhanden. _
" & vbLf & "Soll diese Datei ersetzt werden?", vbQuestion + vbYesNo, "ACHTUNG!!")
If Qe = vbNo Then strPDF_Name = InputBox("Geben Sie den Namen ein, unter _
dem das Dokument gespeichert werden soll.", "Bitte neuen Dateinamen vergeben")
If Qe = vbYes Then Environ ("userprofile") & "\Desktop\" & .Name & ".pdf"
strPDF_Name = IIf(Right$(LCase(strPDF_Name), 4) = ".pdf", strPDF_Name, strPDF_Name & ".pdf")
End If
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Environ("userprofile") & "\Desktop\" & .Name & ".pdf", Quality:=xlQualityStandard, _
_
_
_
_
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End With
Next wks
End Sub
Ich glaube diese Zeile ist sogar überflüssig, oder?
strPDF_Name = IIf(Right$(LCase(strPDF_Name), 4) = ".pdf", strPDF_Name, strPDF_Name & ".pdf")
ABER:
Probleme über Probleme:
1. Ein Name wird eingegeben - dieser wird aber nicht übernommen, stattdessen wird die bestehende Datei ersetzt (nach Test festgestellt). Hier muss ich wahrscheinlich noch festlegen, dass die Datei dann auch mit diesem Namen "exportiert" werden soll. Wahrscheinlich mit Hilfe von:
oWB.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Desktop & strPDF_Name, Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, OpenAfterPublish:=False
oder ähnlichem. Aber das ist mir schon jetzt zu kompliziert.
2. Wenn ich bei der Aufforderung zum Namen auf Abbruch gehe wird die Datei erstellt und die Alte überschrieben. Ich gehe davon aus, dass dies eine If Dir bzw. If Qe Zeile bedarf, aber da komme ich schon nicht mehr weiter.