Kopie von Lieferschein / Rechnung anlegen und Makro-Code löschen

Dieses Thema Kopie von Lieferschein / Rechnung anlegen und Makro-Code löschen im Forum "Microsoft Office Suite" wurde erstellt von safer, 7. Nov. 2005.

Thema: Kopie von Lieferschein / Rechnung anlegen und Makro-Code löschen Moin, ich kann das auch gut gebrauchen ;) Ich hätte aber gern eine kleine Abwandlung. Und zwar soll das Original...

  1. Moin,
    ich kann das auch gut gebrauchen ;)
    Ich hätte aber gern eine kleine Abwandlung.
    Und zwar soll das Original nicht geschlossen werden.
    Die Datei soll nur im Hintergrund gespeichert werden.
    Hintergrund dieser Angelegenheit:
    Es werden hier sehr viele Lieferscheine und Rechnungen erstellt, in denen eine Automatische Nummerierung integriert ist (Wird beim  Ausdrucken hochgezählt). Diese Dateien wurden bisher immer nur ausgedruckt. Jetzt werden diese Dateien auch bei Bedarf gespeichert.

    Als ich dieses Posting gelesen hatte, dachte ich mir, das wäre doch nicht schlecht, wenn die erstellte Datei mit der aktuellen Lieferscheinnummer und dem Namen des Empfängers im Hintergrund abgespeichert wird. Funzt ja auch mit hilfe der hier gefundenen Lösung (ActiveWorkbook.SaveAs Filename:=........) Doch leider wird dabei das Original geschlossen.

    Hätte da jemand auch noch einen Lösungsvorschlag?

    Danke

    safer
     
  2. Hallo safer,

    dann benutze    ...SaveCopyAs anstatt ....SaveAs...

    Gruß Matjes :)
     
  3. Moin,
    danke für deine Antwort:
    Hab ich jetzt so geändert, die Originaldatei wird trotzdem geschlossen, und es wird die gespeicherte Datei im Excel angezeigt.
    Ich möchte nur eine Kopie zu Recherchezwecken im Hintergrund abspeichern.

    Danke und Gruß
    safer
     
  4. Hallo safer,

    eigentlich sollte das klappen. Hab dir nochmel einen Beispiel-Makro geschrieben.

    Gruß Matjes :)
    Code:
    Sub Excel_KopieDerAktuellenMappeAnlegen()
      
      Dim wb As Workbook, s_Kopie_NameFull As String
      
      Set wb = ActiveWorkbook
      
     ->Namen für Sicherung aufbereiten
      s_Kopie_NameFull = _
        wb.Path & \ & _
        Left(wb.Name, Len(wb.Name) - 4) & _
        Format(Now(), _yyyymmdd_hhnnss) & _
        Right(wb.Name, 4)
      
     ->Kopie der aktuellen Arbeitsmappe unter neuem Namen erstellen
      wb.SaveCopyAs Filename:=s_Kopie_NameFull
      
      Set wb = Nothing
    End Sub
     
  5. Hallo Matjes,
    danke für dein Beispiel.
    Trotz mehrfachem Testen mit deinem Beispiel kam ich zu keinem Ergebnis.
    Beim Speichern auf ein Netzlaufwerk ist nichts passiert. Aber egal, ich habe noch einwenig mit
    SaveCopyAs.... Rumexperimentiert. Komisch jetzt klappt es. 8)

    Hast du evtl. auch noch eine Lösung Parat, wie ich alle Makros beim
    Speichern aus dieser Arbeitsmappe entfernen könnte??

    Hintergrund:
    Wurde schon mal ganz kurz bei WT behandelt: http://www.wintotal-forum.de/index.php/topic,97011.0.html
    Funzt, aber schön sauber ist diese Lösung leider nicht.
    Da ich auch über Auto_Open die Verknüpfungen aktualisieren lasse, und diese Aktion bei den gespeicherten Dateien nicht mehr benötigt wird ist das ganze nicht ganz so toll.

    Danke und Gruß
    safer
     
  6. Hallo safer,

    das soll also eine Erweiterung des SaveCopyAs werden, der dann alle Makros entfernt.

    Mal schauen ... Da muß ich erstmal etwas experimentieren.

    Gruß Matjes  :)
     
  7. Hausfrauentip:
    Wenn das ein Lieferschein ist, besteht er doch aus nur einem einzigen Tabellenblatt.
    Dazu könnte man einfach eine neue Datei aufrufen, den Lieferschein erst als Werte einfügen dann als Formate einfügen rüberkopieren und unter sonstwas abspeichern.
    In der Kopie sind dann keine Formeln und keine Makros:
    Ich gehe davon aus, daß der Name/Kundennummer im Lieferschein in Zelle E5 steht. Dann hat die Kopie auch eine sachliche Zuordnung neben der zeitlichen
    Code:
    Sub Kopie_des_Lieferscheins()
      Dim orig_wb As Workbook, s_Kopie_NameFull As String
      Set orig_wb = ActiveWorkbook
     
     ->Namen für Sicherung aufbereiten
      s_Kopie_NameFull = _
        orig_wb.Path & \ & _
        Left(orig_wb.Name, Len(orig_wb.Name) - 4) & _
        Format(_) & Format(Range(E5)) & _
        Format(Now(), _yyyy-mm-dd_hh-nn-ss) & _
        Right(orig_wb.Name, 4)
        Workbooks.Add
        ActiveWindow.ActivateNext
        Cells.Select
        Selection.Copy
        ActiveWindow.ActivatePrevious
       ->Werte einfügen
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        ActiveWindow.ActivateNext
        Selection.Copy
        ActiveWindow.ActivatePrevious
        Cells.Select
       ->Formate einfügen
        Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Application.CutCopyMode = False
        Range(A1).Select
       ->Jetzt nicht ***orig_wb.SaveAs***, denn das würde die Originaldatei mitsamt Makros usw. speichern
       ->stattdessen ***ActiveWorkbook.SaveAs***, denn das ist die im Vordergrund befindliche Kopie
        ActiveWorkbook.SaveAs FileName:=s_Kopie_NameFull
        ActiveWorkbook.Close
        Range(A1).Select
       ->Vorlage wird auch gespeichert, bleibt aber offen.
        ActiveWorkbook.Save
      Set wb = Nothing
    End Sub
     
  8. Hallo Klexy,

    erstmal danke für deine Bemühung. Deinen Hausfrauentip muß ich mir morgen mal in aller Ruhe anschauen. :)

    Ich habe das mit dem Speichern des Lieferscheins ohne Verknüpfungen schon erledigt.
    Klappt auch Wunderbar. Der Hintergrund an der Sache ist halt, das ja im Auto_Open die Aktualisierung der Verknüpfungen drinsteht.
    Da aber alle Verknüpfungen nicht mehr da sind, oder die Datei wird als E-Mail verschickt,
    kann ja nicht mehr auf die Verknüpfte Datei zugegriffen werden. Somit ist beim Öffnen eine Fehlermeldung vorprogramiert.


    Hallo Matjes,
    Nicht unbedingt.
    Der Anwender hat die Möglichkeit die Datei über einen Button auszudrucken. mit Nr. hochzählen.
    In das Makro hab ich das ActiveWorkbook.SaveAs.... eingebaut. Die Datei wird somit auch Archiviert.

    Da die Anwender manche Dateien bewusst speichern wollen gibt es noch ein Macro Speichern_unter()
    Hier werden alle Bezüge der Formeln und die Makro-Buttons aus der Datei entfernt.
    Und hier möchte ich eigentlich auch alle Makros aus der Datei entfernen. So das es eine Stink normale Exceldatei ist.

    Und nun noch ein Hallo an alle anderen.  ;D ;D

    PS @Matjes, ist es eventuell Sinvoll aus diesem Beitrag einen Eigenständigen zu machen? Hat ja eigentlich nichts mehr mit dem Thema Zelleninhalt merken und als Dateinamen verwenden ??? zu tun.

    Dank und gruß
    safer
     
  9. Hallo safer,

    jo, werd' den Thread teilen. Muß mich aber erstmal kundig machen, wie das genau geht, sonst schneid ich ihn an der falschen Stelle durch  ;D

    Zu den Makros:
    Ich hab dir erstmal SaveCopyas um die Code-Bereinigung erweitert.

    Eigentlich kannst du den gut für dein Speichern unter verwenden.
    Der Dateiname wird um Datum/Uhrzeit erweitert.

    Beim Löschen der Code-Module ist es  in meinen Augen notwendig, 
    daß der ausführende Makro nicht in der zu bereinigende Mappe liegt,
    sonst zieht er sich selbst die Existenzberechtigung unter den füssen weg.

    Desweiteren hat Excel etwas dagegen, 2 Dateien mit gleichem Dateinamen in unterschiedlichen Verzeichnissen gleichzeitig zu öffnen.

    Wenn Du also beim->Speichern unter' eine Kopie im neuen Zielordner mit um Datum/Uhrzeit erweitertem Dateinamen ablegst, kann der Makro in der Kopie die Makros entfernen.

    Gruß Matjes :)

    Code:
    Option Explicit
    '******************************************************************************************
    Sub Excel_KopieMitDatumAnlegenUndMakrosEntfernen()
      
      Dim s_Kopie_NameFull As String
      
      If Not Excel_KopieDerAktuellenMappeAnlegen(s_Kopie_NameFull) Then GoTo AUFRAEUMEN
    
      If Not Excel_CodeEntfernen(s_Kopie_NameFull) Then GoTo AUFRAEUMEN
      
      MsgBox ( _
        Es wurde eine Kopie der aktuellen Datei angelegt und von Code bereinigt. & vbLf & _
        vbLf & _
        aktuelle Datei: & vbLf & _
        ActiveWorkbook.FullName & vbLf & _
        vbLf & _
        Kopie: & vbLf & _
        s_Kopie_NameFull & vbLf & _
        vbLf & _
        :-)   :-)   :-)   :-)   :-)   :-)   :-)   :-)   :-)    & _
        :-)   :-)   :-)   :-)   :-)   :-)   :-)   :-)   :-)   )
    AUFRAEUMEN:
    End Sub
    '******************************************************************************************
    Private Function Excel_CodeEntfernen(s_Kopie_NameFull As String) As Boolean
      Dim wb As Workbook, x As Long
      Dim s_Name As String, l_Type As Variant
      
      Excel_CodeEntfernen = False
      
      Set wb = Workbooks.Open(FileName:=s_Kopie_NameFull)
     -> :-) :-) :-) Dabei werden Makros nicht ausgeführt :-) :-) :-) !!!
      
      On Error Resume Next
      
     ->Prüfen, ob überhaupt auf die VB-Komponenten zugegriffen werden kann
      x = wb.VBProject.VBComponents.Count
      If Err.Number <> 0 Then
        MsgBox ( _
          VBKomponenten können nicht gelöscht werden. & vbLf & vbLf & _
          Err.Description)
        GoTo AUFRAEUMEN
      End If
        
      For x = wb.VBProject.VBComponents.Count To 1 Step -1
        l_Type = wb.VBProject.VBComponents(x).Type
        Select Case l_Type
          Case 100->vbext_ct_Document    : DieseArbeitsmappe, Tabelle...
           ->Alle Codezeilen löschen
            With wb.VBProject.VBComponents(x).CodeModule: .DeleteLines 1, .CountOfLines: End With
          Case 1, 2, 3
           ->1 = vbext_ct_StdModule   : normale Module
           ->2 = vbext_ct_ClassModule : KlassenModule
           ->3 = vbext_ct_Forms       : Userform
            wb.VBProject.VBComponents.Remove wb.VBProject.VBComponents(x)
          Case Else
            MsgBox (Unbekannte VBComponent. Type =  & l_Type)
            GoTo AUFRAEUMEN
        End Select
        
      Next
     ->Schliessen mit speichern
      wb.Close Savechanges:=True
      
      Excel_CodeEntfernen = True
      
    AUFRAEUMEN:
      Err.Clear
      On Error GoTo 0
      Set wb = Nothing
      Exit Function
    End Function
    '******************************************************************************************
    Private Function Excel_KopieDerAktuellenMappeAnlegen(s_Kopie_NameFull As String) As Boolean
      
      Dim wb As Workbook
      
      Excel_KopieDerAktuellenMappeAnlegen = False
      
      Set wb = ActiveWorkbook
      
     ->Namen für Sicherung aufbereiten
      s_Kopie_NameFull = _
        wb.Path & \ & _
        Left(wb.Name, Len(wb.Name) - 4) & _
        Format(Now(), _yyyymmdd_hhnnss) & _
        Right(wb.Name, 4)
      
     ->Kopie der aktuellen Arbeitsmappe unter neuem Namen erstellen
      On Error Resume Next
      wb.SaveCopyAs FileName:=s_Kopie_NameFull
      If Err.Number <> 0 Then
        Err.Clear
        MsgBox ( _
          Kopie der aktuellen Mappe konnte nicht angelegt werden. & vbLf & _
          s_Kopie_NameFull)
        GoTo AUFRAEUMEN
      End If
      
      Excel_KopieDerAktuellenMappeAnlegen = True
    AUFRAEUMEN:
      On Error GoTo 0
      Set wb = Nothing
    End Function
     
  10. Hallo Matjes,
    das sieht ja schon Super aus.
    Ich bekomme aber Leider eine Fehlermeldung beim
    ->Prüfen, ob überhaupt auf die VB-Komponenten zugegriffen werden kann
    Fehlermeldung:
    VBKomponenten können nicht gelöscht werden.
    Der programmatische Zugriff auf das Visual Basic-Projekt ist nicht sicher.

    Kann ich da irgendwo was einstellen??

    Danke und gruß
    safer
     
Die Seite wird geladen...

Kopie von Lieferschein / Rechnung anlegen und Makro-Code löschen - Ähnliche Themen

Forum Datum
Bilder von Karte automatisch ins Netzwerk kopieren. Womit? Software: Empfehlungen, Gesuche & Problemlösungen 2. Okt. 2016
Software für DVD-Kopien on the fly Software: Empfehlungen, Gesuche & Problemlösungen 29. Juli 2016
Dateigröße nach Kopiervorgang unrealistisch groß Windows 10 Forum 26. März 2016
Befehl zum Kopieren von LInks Windows 10 Forum 19. Feb. 2016
Datein kopieren Software: Empfehlungen, Gesuche & Problemlösungen 14. Feb. 2016