Hallo Excel Freunde
bräuchte mal eure Hilfe , im nachfolgendem Code wird ein excelblatt ausgefüllt uber MsgBoxen und sobald die letzte ausgefüllt wird speichert er das Blatt als PDF im vorgesehenen Ordner , das funktioniert auch sehr gut nur brauche ich für die Arbeit die Datei als .xlsx Datei in dem Ordner.
Oder gibt es eine möglichkeit das man auswählen kann ob PDF oder .xlsx Speichern.
Die Mappe kann ich leider nicht schicken wegen Datenschutz der Firma.
Hier der Code:
Private Sub cb_lackiert_1_Click()
ChDrive "J"
ChDir "J:\KOW\Eingang\Oberflächenformulare"
Workbooks.Open Filename:=("Formular Oberflächenfreigabe lackiert Englisch.xlsm")
Oberflächenformulare.Hide
zahl0 = InputBox("Vorstellung Neuwerkzeug? Wenn JA, dann Eingabe mit X - Wenn Nein, dann mit ENTER weiter")
zahl1 = InputBox("Vorstellung aus der Produktion? Wenn JA, dann Eingabe mit X - Wenn Nein, dann mit ENTER weiter")
zahl2 = InputBox("Bitte geben Sie die Zeichnungsnummer ein")
zahl3 = InputBox("Bitte geben Sie den Änderungsindex ein")
zahl4 = InputBox("Bitte geben Sie die Equipment-Werkzeug ein")
zahl5 = InputBox("Bitte geben Sie die Teilebezeichnung ein")
zahl6 = InputBox("Bitte geben Sie die Fachzahl ein")
zahl7 = InputBox("Bitte geben Sie die Materialbezeichnung ein")
zahl8 = InputBox("Bitte geben Sie die Materialnummer ein")
zahl9 = InputBox("Bitte geben Sie die Projektnummer ein")
zahl10 = InputBox("Bitte geben Sie die Projektbezeichnung ein")
zahl11 = InputBox("Bitte geben Sie Ihren Namen ein")
zahl12 = InputBox("Bitte geben Sie das Datum ein")
Zahl13 = InputBox("Vorstellung Durch Schichtführer? Wenn JA, dann Eingabe mit X - Wenn Nein, dann mit ENTER weiter")
zahl14 = InputBox("Vorstellung Durch Spritztechnikum? Wenn JA, dann Eingabe mit X - Wenn Nein, dann mit ENTER weiter")
zahl15 = InputBox("Vorstellung Durch Werkzeugtechnik? Wenn JA, dann Eingabe mit X - Wenn Nein, dann mit ENTER weiter")
zahl16 = InputBox(" Werzeug produktionsfähig? Wenn JA, dann Eingabe mit X - Wenn Nein, dann mit ENTER weiter")
Zahl17 = InputBox(" Oberflächenbeurteilung Neuwerkzeuge? Wenn JA, dann Eingabe mit X - Wenn Nein, dann mit ENTER weiter")
zahl18 = InputBox(" Oberflächenbeurteilung für MFU? Wenn JA, dann Eingabe mit X - Wenn Nein, dann mit ENTER weiter")
zahl19 = InputBox(" Oberflächenbeurteilung nach Wz. Optimierung/Korrektur? Wenn JA, dann Eingabe mit X - Wenn Nein, dann mit ENTER weiter")
zahl20 = InputBox("Weitergabe an Lackiererei - Schuss / Satz eingeben")
Zahl21 = InputBox("Bitte geben Sie das Datum ein")
zahl22 = InputBox("Bemerkung: Zeile 1 max 74 Zeichen")
Zahl23 = InputBox("Bemerkung: Zeile 2 max 86 Zeichen")
zahl = InputBox("Anzahl Ausdrucke?", , "1")
'If zahl = "" Then GoTo Schließen
Range("H3").Select
ActiveCell.FormulaR1C1 = zahl0
Range("R3").Select
ActiveCell.FormulaR1C1 = zahl1
Range("I6").Select
ActiveCell.FormulaR1C1 = zahl2
Range("Q6").Select
ActiveCell.FormulaR1C1 = zahl3
Range("I8").Select
ActiveCell.FormulaR1C1 = zahl4
Range("I10").Select
ActiveCell.FormulaR1C1 = zahl5
Range("V10").Select
ActiveCell.FormulaR1C1 = zahl6
Range("I12").Select
ActiveCell.FormulaR1C1 = zahl7
Range("I14").Select
ActiveCell.FormulaR1C1 = zahl8
Range("I16").Select
ActiveCell.FormulaR1C1 = zahl9
Range("V16").Select
ActiveCell.FormulaR1C1 = zahl10
Range("I18").Select
ActiveCell.FormulaR1C1 = zahl11
Range("V18").Select
ActiveCell.FormulaR1C1 = zahl12
Range("H22").Select
ActiveCell.FormulaR1C1 = Zahl13
Range("U22").Select
ActiveCell.FormulaR1C1 = zahl14
Range("AE22").Select
ActiveCell.FormulaR1C1 = zahl15
Range("S25").Select
ActiveCell.FormulaR1C1 = zahl16
Range("S26").Select
ActiveCell.FormulaR1C1 = Zahl17
Range("S27").Select
ActiveCell.FormulaR1C1 = zahl18
Range("S28").Select
ActiveCell.FormulaR1C1 = zahl19
Range("R30").Select
ActiveCell.FormulaR1C1 = zahl20
Range("I36").Select
ActiveCell.FormulaR1C1 = Zahl21
Range("G37").Select
ActiveCell.FormulaR1C1 = zahl22
Range("G38").Select
ActiveCell.FormulaR1C1 = Zahl23
'If zahl = "" Then GoTo Schließen
Range("A1:AF149").Select
With Selection
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="J:\KOW\Eingang\Oberflächenformulare\Vorstellung\Oberflächenfreigabe lackiert Englisch_" & Range("I6") & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=True, OpenAfterPublish:=False
.PrintPreview
End With
Gruß Michael