Excel - makro pro ukladani souboru

[w3ris]

Zdravim,
zdedil jsem tu makro, ktere by melo otevrit okno "ulozit jako" a nabidnout nazev, dle jiz predtim ziskanych dat. Nastroj ulozit jako se otevre, ale nazev je prazdny a proto ho ted musim manualne dopisovat. Nerozumim ani tem podtrzitkum na konci radku, ale pokud je smazu, VB hlasi chybu, coz predtim nedela (i kdyz to nefunguje jak by melo). Ulozeny soubor navic neni ve formatu .xls

Nekdo nejaky napad? Nebo to radsi prepsat cely?

Diky!

Kód: Vybrat vše

Sheets("Startblatt").Select
     ScreenUpdating = True
     
     Prompt = "Bitte geben Sie die V-Nummer ein (ohne V-0)(z.B. 88300-45-000):"
     Title = "Auftragsnummer"
     vnummer = Application.InputBox(Prompt, Title, , 210, 0, , , 2)
     If vnummer = False Then End
     Range("zw!B37") = vnummer
     
     Prompt = "Bitte geben Sie Ihr Kurzzeichen ein (z.B. DZ, LOI, ...):"
     Title = "Kurzzeichen"
     kurz = Application.InputBox(Prompt, Title, , 210, 0, , , 2)
     If kurz = False Then End
    'Umwandlung in Großbuchstaben
     Range("zw!B50") = kurz
     kurz = Range("zw!C50")

Sheets("zw").Cells(37, 2) = vnummer
    hersteller = Sheets("zw").Cells(40, 3)
    If hersteller = "keine Angabe" Then hersteller = "HERSTELLER"
  ' Datei speichern
     datnam = vnummer & " ÜBBL " & kurz & " " & hersteller & ".xls"
Speichern:
     Do
       sfname = Application.GetSaveAsFilename(datnam, "Bitte Ordner für Abnahmedatei auswählen!")
     Loop Until sfname <> False
 
     On Error Resume Next
     ActiveWorkbook.SaveAs fileName:=sfname, _
                   FileFormat:=xlNormal, _
                   Password:="", _
                   WriteResPassword:="", _
                   ReadOnlyRecommended:=False, _
                   CreateBackup:=False
        If Err.Number <> 0 Then
         test = MsgBox("Bitte nocheinmal versuchen", "Fehler bei Dateiangabe")
         GoTo Speichern
        End If
        On Error GoTo 0

[Reklama]

[pavel.lasak]

Vypadá že nejde o celý kód nevidím definované:
vnummer
kurz
hersteller

podtrzítka zmanemají že kód pokračuje na dalším řádku (z důvodu přehlednosti)

[w3ris]

Je to celkem dlouhej kod, takze jsem to nechtel vkladat cely a vkladani promennych funguje.. pridal jsem vsechno, co souvisi s tema promennyma..

[cmuch]

Nahraď část za ' Datei speichern timto

Kód: Vybrat vše

' Datei speichern
     datnam = vnummer & " ÜBBL " & kurz & " " & hersteller
Speichern:
     Do
       sfname = Application.GetSaveAsFilename(InitialFileName:=datnam, FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Bitte Ordner für Abnahmedatei auswählen!")
     Loop Until sfname <> False
 
     On Error Resume Next
     
     ActiveWorkbook.SaveAs Filename:=sfname, _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
     If Err.Number <> 0 Then
         test = MsgBox("Bitte nocheinmal versuchen", "Fehler bei Dateiangabe")
         GoTo Speichern
     End If
     On Error GoTo 0