Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
544to548
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
544to548
544to548
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

entfernen Private Sub über VB

entfernen Private Sub über VB
09.01.2005 17:01:24
Korl
Hallo,
ich habe ein Tabellenblatt das aus einer bestehenden Mappe herausgenommen wird um wiederum separat abzuspeichern.
Nun liegt in diesem Tabellenblatt im VB aber noch 2 Private Sub, die ich vor der Abspeicherung entfernen möchte.
Es sind diese beiden:

Private Sub Worksheet_Activate()
Application.MoveAfterReturnDirection = xlToRight
End Sub


Private Sub Worksheet_Deactivate()
Application.MoveAfterReturnDirection = xlDown
End Sub

Da ich noch weitere Funktionen erledigen möchte, soll die o.g. Funktion in meinen Code eingebunden werden.
Lässt es sich so ohne weiteres realisieren?
Gruß Korl

20
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: entfernen Private Sub über VB
09.01.2005 17:05:29
Josef
Hallo Korl!
Da hilft dir das weiter:


Option Explicit
   
Public Sub Code_loeschen()
   'Gesamten Code und Module l\f1öschen
   'von K.Rola
   Dim myVBComponents As Object
   If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
   'sicherheits-check um nicht sich selbst zu löschen
   With ActiveWorkbook.VBProject
      For Each myVBComponents In .VBComponents
         Select Case myVBComponents.Type
            Case 1, 2, 3
               .VBComponents.Remove .VBComponents(myVBComponents.Name)
            Case 100
               With myVBComponents.CodeModule
                  .DeleteLines 1, .CountOfLines
               End With
         End Select
      Next
   End With
End Sub\f0 


Gruß Sepp
Anzeige
Codedarstellung fehlerhaft!
09.01.2005 17:14:10
Josef
Hallo Korl!
Da ist mit der Codedarstellung was schiefgelaufen, darum hier nochmal der Code!


      
Public Sub Code_loeschen()
   
'Gesamten Code und Module löschen
   'von K.Rola
   Dim myVBComponents As Object
   
If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
   
'sicherheits-check um nicht sich selbst zu löschen
   With ActiveWorkbook.VBProject
      
For Each myVBComponents In .VBComponents
         
Select Case myVBComponents.Type
            
Case 1, 2, 3
               .VBComponents.Remove .VBComponents(myVBComponents.Name)
            
Case 100
               
With myVBComponents.CodeModule
                  .DeleteLines 1, .CountOfLines
               
End With
         
End Select
      
Next
   
End With
End Sub 


Gruß Sepp
Anzeige
AW: entfernen Private Sub über VB
09.01.2005 17:31:22
Korl
Hallo Sepp,
ich hab's geahnt, das ist zu hoch für mich. Versucht habe ich es mit der "call" Funktion. Das hat nicht funktioniert.
Hier mal mein gesamter Code

Sub Archivieren()
If Worksheets("Rechnung").Range("F52") = 0 Then
Debug.Print MsgBox("Es wurde noch keine Rechnung erstellt!", 64, "Hinweis")
End If
' erst beginnen wenn der Rechnungsbetrag >0 ist
If Worksheets("Rechnung").Range("F52") > 0 Then
' Bildschirm ausschalten
Application.ScreenUpdating = False
' Name der neuen Arbeitsmappe
Datname = Range("B21")
' aktuelle Zeile für den Eintrag in das Blatt Rechnungen
Aktzeile = Range("C21")
' aktuelles Datum
Aktdat = Range("F26")
' aktuelle Kundennummer
Aktknr = Range("F25")
' Anrede des Kunden
Kundanrede = Range("B14")
' Vorname und Name des Kunden
Kundname = Range("B15")
' Zusatz zum Kunden
Aktzusatz = Range("B16")
' Straße des Kunden
Kundstras = Range("B17")
'Wohnort des Kunden
Kundort = Range("B18")
Smeter = Range("B48")
' Nettobetrag der aktuellen Rechnung
Kundnetto = Range("F49")
' Mwst.-Betrag der aktuellen Rechnung
Kundmwst = Range("F50")
' Bruttobetrag der aktuellen Rechnung
Kundbrutto = Range("F52")
' Neue Arbeitsmappe mit einem Tabellenblatt anlegen
With Application
.SheetsInNewWorkbook = 1
End With
Workbooks.Add
' Neue Arbeitsmappe speichern (Dateiname = Rechnungsnummer)
' In Nachfolgezeile kann der Pfad korrigiert werden
ActiveWorkbook.SaveAs FileName:= _
"C:\Programme\Verein\Archiv-Rechnungen\" & Datname, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
With Application
.SheetsInNewWorkbook = 5
End With
' Wechseln auf das Original-Rechnungsblatt
Windows("Sägerei Felten.xls").Activate
Sheets("Rechnung").Select
' verschiebt das Blatt "Ausdruck" in die neue Mappe "Datname"
Sheets("Rechnung").Copy Before:=Workbooks(Datname).Sheets(1)
ActiveWindow.FreezePanes = False
'Blattschutz aufheben
Sheets("Rechnung").Select
With Sheets("Rechnung")
.Unprotect Password:="xxx"
.Protect Contents:=True, UserInterfaceOnly:=True, Password:="xxx"
End With
'Kopiert und fügt nur Werte und Formate ein, sperrt komplett
Cells.Select
Selection.Locked = True
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Range("B31").Select
Application.DisplayAlerts = 0
Sheets("Tabelle1").Delete
Application.DisplayAlerts = 1
HIER HABE ICH's mit "call" versucht
' speichert und schließt die neue Mappe
ActiveWindow.SmallScroll Down:=-23
ActiveWorkbook.Save
ActiveWorkbook.Close
' Daten der ausgefüllten Rechnung im Tabellenblatt Liste ablegen
Range("H7").Select
Sheets("Liste").Select
Cells(Aktzeile, 2).Formula = Aktdat
Cells(Aktzeile, 3).Formula = Aktknr
Cells(Aktzeile, 4).Formula = Kundnetto
Cells(Aktzeile, 5).Formula = Kundmwst
Cells(Aktzeile, 6).Formula = Kundbrutto
Cells(Aktzeile, 11).Formula = Kundanrede
Cells(Aktzeile, 12).Formula = Kundname
Cells(Aktzeile, 13).Formula = Kundzusatz
Cells(Aktzeile, 14).Formula = Kundstras
Cells(Aktzeile, 15).Formula = Kundort
Cells(Aktzeile, 16).Formula = Smeter
'Original-Rechnung leeren
Sheets("Rechnung").Select
Range("B33:E46").Select
Selection.ClearContents
Range("B33").Select
' Blidschirmaktualisierung einschalten
Application.ScreenUpdating = True
Sheets("Liste").Select
Application.DisplayFormulaBar = True
End If
End Sub

Sepp, ich weiß es ist alles etwas Laienhaft gestrickt, aber ich freue mich immer wieder wenn’s klappt.
Kann man da was machen?
Gruß Korl
Anzeige
AW: entfernen Private Sub über VB
09.01.2005 17:44:52
Korl
Hallo Sepp,
ich habe es mit Deinem 2. angebotenem Code geschafft. Es funktioniert!!
Was mich jetzt nur wundert, ist, wenn ich das Tabellenblatt mit den befreiten Makros ;-)aufrufe, dass trotzdem Makros enthalten sein sollen!
Bekommt man das auch noch weg?
Sepp, besten Dank erstmal für Deine Mühe! (Nicht das es bei meiner Euphorie noch unter geht)
Gruß Korl
AW: entfernen Private Sub über VB
09.01.2005 17:55:13
Josef
Hallo Korl!
Ungetestet, weil ich das nicht alles nachbauen will ;-))


      
Option Explicit
Sub Archivieren()
    
If Worksheets("Rechnung").Range("F52") = 0 Then
    
Debug.Print MsgBox("Es wurde noch keine Rechnung erstellt!", 64, "Hinweis")
    
End If
' erst beginnen wenn der Rechnungsbetrag >0 ist
    If Worksheets("Rechnung").Range("F52") > 0 Then
' Bildschirm ausschalten
On erroro GoTo ERRORHANDLER
    Application.ScreenUpdating = 
False
' Name der neuen Arbeitsmappe
    Datname = Range("B21")
' aktuelle Zeile für den Eintrag in das Blatt Rechnungen
    Aktzeile = Range("C21")
' aktuelles Datum
    Aktdat = Range("F26")
' aktuelle Kundennummer
    Aktknr = Range("F25")
' Anrede des Kunden
    Kundanrede = Range("B14")
' Vorname und Name des Kunden
    Kundname = Range("B15")
' Zusatz zum Kunden
    Aktzusatz = Range("B16")
' Straße des Kunden
    Kundstras = Range("B17")
'Wohnort des Kunden
    Kundort = Range("B18")
    Smeter = Range("B48")
' Nettobetrag der aktuellen Rechnung
    Kundnetto = Range("F49")
' Mwst.-Betrag der aktuellen Rechnung
    Kundmwst = Range("F50")
' Bruttobetrag der aktuellen Rechnung
    Kundbrutto = Range("F52")
    
'!!!!!!!!!Beginn der Änderungen!!!!!!!!!!!!!!

' Neue Arbeitsmappe mit einem Tabellenblatt anlegen
'''    With Application
'''        .SheetsInNewWorkbook = 1
'''    End With
'''    Workbooks.Add
'''' Neue Arbeitsmappe speichern (Dateiname = Rechnungsnummer)
'''' In Nachfolgezeile kann der Pfad korrigiert werden
'''    ActiveWorkbook.SaveAs Filename:= _
'''        "C:\Programme\Verein\Archiv-Rechnungen\" & Datname, _
'''        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
'''        ReadOnlyRecommended:=False, CreateBackup:=False

'''    With Application
'''        .SheetsInNewWorkbook = 5
'''    End With
' Wechseln auf das Original-Rechnungsblatt
'''    Windows("Sägerei Felten.xls").Activate
'''    Sheets("Rechnung").Select
' verschiebt das Blatt "Ausdruck" in die neue Mappe "Datname"
    
'##  Wenn man ein einzelnes Tabellenblatt als Workbook speichern will,
'    dann geht das direkt, ohne das man vorher ein neues workbook erstellt!

    Sheets("Rechnung").Copy
    
    ActiveWorkbook.SaveAs Filename:= _
    "C:\Programme\Verein\Archiv-Rechnungen\" & Datname
    ActiveWindow.FreezePanes = 
False
'Blattschutz aufheben
With ActiveWorkbook
   
With .Sheets(1)
      .Unprotect Password:="xxx"
      .Protect Contents:=
True, UserInterfaceOnly:=True, Password:="xxx"
      
      
'Kopiert und fügt nur Werte und Formate ein, sperrt komplett
      .Cells.Locked = True
      .Cells.Copy
      .Cells.PasteSpecial Paste:=xlValues
      .Cells.PasteSpecial Paste:=xlFormats
      Application.CutCopyMode = 
False
      .Rows("1:2").Delete Shift:=xlUp
      .Range("B31").Select
   
End With
'Code entfernen

Code_loeschen
'#######

' speichert und schließt die neue Mappe
.Save
.Close
End With
'!!!!!!!!!Ende der Änderungen!!!!!!!!!!!!!!

' Daten der ausgefüllten Rechnung im Tabellenblatt Liste ablegen
    Range("H7").Select
    Sheets("Liste").Select
    Cells(Aktzeile, 2).Formula = Aktdat
    Cells(Aktzeile, 3).Formula = Aktknr
    Cells(Aktzeile, 4).Formula = Kundnetto
    Cells(Aktzeile, 5).Formula = Kundmwst
    Cells(Aktzeile, 6).Formula = Kundbrutto
    Cells(Aktzeile, 11).Formula = Kundanrede
    Cells(Aktzeile, 12).Formula = Kundname
    Cells(Aktzeile, 13).Formula = Kundzusatz
    Cells(Aktzeile, 14).Formula = Kundstras
    Cells(Aktzeile, 15).Formula = Kundort
    Cells(Aktzeile, 16).Formula = Smeter
'Original-Rechnung leeren
    Sheets("Rechnung").Select
    Range("B33:E46").Select
    Selection.ClearContents
    Range("B33").Select
' Blidschirmaktualisierung einschalten
ERRORHANDLER:
    Application.ScreenUpdating = 
True
    Sheets("Liste").Select
    Application.DisplayFormulaBar = 
True
    
End If
End Sub
Public Sub Code_loeschen()
   
'Gesamten Code und Module löschen
   'von K.Rola
   Dim myVBComponents As Object
   
If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
   
'sicherheits-check um nicht sich selbst zu löschen
   With ActiveWorkbook.VBProject
      
For Each myVBComponents In .VBComponents
         
Select Case myVBComponents.Type
            
Case 1, 2, 3
               .VBComponents.Remove .VBComponents(myVBComponents.Name)
            
Case 100
               
With myVBComponents.CodeModule
                  .DeleteLines 1, .CountOfLines
               
End With
         
End Select
      
Next
   
End With
End Sub
 


Gruß Sepp
Anzeige
AW: entfernen Private Sub über VB
09.01.2005 18:33:08
Korl
Hallo Sepp,
danke das Du Dir noch mal die Mühe gemacht hast mir im Detail den Code zusammen zu stellen und dann noch aufgeräumt hast.
Ich muß Dir ehrlicher Weise auch sagen, dass ich im Stillen damit gehofft habe ;-)
Es hatten sich aber auch unsere Postings überschnitten.
Nun habe ich festgestellt, dass im abgelegten Tabellenblatt immer noch eine Verknüpfung zur alten Mappe hängt. Bekommt man diese Verknüpfung auch noch weg?
Gruß Korl
AW: entfernen Private Sub über VB
09.01.2005 18:55:51
Josef
Hallo Korl!
Hmm, mit dem Umwandeln der Formeln in Werte, sind eigentlich auch
die Verknüpfungen weg!
Hast du vieleicht benannte bereiche in der Tabelle die sich auf andere Blätter beziehen?
Wenn ja, dann Füge in das Modul mit deinem Code noch dieses Makro ein
und rufe es nach dem makro zum löschen des Codes auf!


      
Sub delNames()
Dim myName As Name
If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
For Each myName In ActiveWorkbook.Names
myName.Delete
Next
End Sub 


Gruß Sepp
Anzeige
fast am Ziel
09.01.2005 19:39:33
Korl
Hallo Sepp,
die Namen werden jetzt auch gelöscht und unter Menü "Bearbeiten/Verknüpfungen" ist auch nichts mehr. Verknüpfung ist sogar inaktiv und trotzdem meint Excel beim laden dieser Tabelle es währen Makros vorhanden.
Ich habe noch mal ein bischen experimentiert, und zwar habe ich die Tabelle aufgerufen den Blattschutz entfernt und sofort wieder aktiviert und gespeichert.
Bei erneutem Aufruf wurde sie ohne Makrohinweis geöffnet.
Und nu? :-(
Gibt es da noch was gegen?
Gruß Korl
AW: fast am Ziel
Ulf
Entferne die Makros schon in der Quellmappe und kopier die Blätter erst dann.
Die Quelle musst du dann ohne Speicherung schließen.
Ulf
Anzeige
AW: fast am Ziel
09.01.2005 22:12:43
Korl
Hallo Ulf,
danke für Deinen Tipp, leider ist das was ich da gemacht habe auch nur ein Liebesdienst innerhalb meiner Sippe und dann sieht es schon wieder schwieriger aus.
Das kurriose dabei ist, dass ja alle Makros, Namen und Verknüpfungen raus sind.
Wenn es nicht geht ist es dann auch egal, wollte es aber doch noch offen halten.
Danke möchte ich aber ausschließlich Sepp nochmal sagen!
Gruß Korl
AW: fast am Ziel
09.01.2005 23:05:43
Josef
Hallo Korl!
Ich hab das jetzt durchprobiert und es scheint so, als
ob nur der von Ulf aufgezeigte weg das Problem löst.
Im Moment fällt mir dazu nichts anderes ein!
Gruß Sepp
Anzeige
AW: fast am Ziel
Ulf
Das ist der einzige Weg, bin mir aber nicht sicher, ob Korl das verstanden hat.
Ulf
Danke Ulf und Sepp
09.01.2005 23:32:08
Korl
Hallo Ulf und Sepp,
hatte mich bis eben noch in der Recherche herum getummelt. Scheint doch ein Problem zu sein.
Ich denke, dass ich es verstanden habe. Ich kann damit leben.;-)
Danke Euch beiden für die Mühe.
Gruß Korl
AW: Danke Ulf und Sepp
09.01.2005 23:36:59
Josef
Hallo Korl!
So gehts!
Ist nicht die saubere Art aber was solls;-)


Sub Archivieren()
    
If Worksheets("Rechnung").Range("F52") = 0 Then
    
Debug.Print MsgBox("Es wurde noch keine Rechnung erstellt!", 64, "Hinweis")
    
End If
' erst beginnen wenn der Rechnungsbetrag >0 ist
    If Worksheets("Rechnung").Range("F52") > 0 Then
' Bildschirm ausschalten
On erroro GoTo ERRORHANDLER
    Application.ScreenUpdating = 
False
' Name der neuen Arbeitsmappe
    datname = Range("B21")
' aktuelle Zeile für den Eintrag in das Blatt Rechnungen
    Aktzeile = Range("C21")
' aktuelles Datum
    Aktdat = Range("F26")
' aktuelle Kundennummer
    Aktknr = Range("F25")
' Anrede des Kunden
    Kundanrede = Range("B14")
' Vorname und Name des Kunden
    Kundname = Range("B15")
' Zusatz zum Kunden
    Aktzusatz = Range("B16")
' Straße des Kunden
    Kundstras = Range("B17")
'Wohnort des Kunden
    Kundort = Range("B18")
    Smeter = Range(
"B48")
' Nettobetrag der aktuellen Rechnung
    Kundnetto = Range("F49")
' Mwst.-Betrag der aktuellen Rechnung
    Kundmwst = Range("F50")
' Bruttobetrag der aktuellen Rechnung
    Kundbrutto = Range("F52")
    
'#########################################
    Sheets("Rechnung").Copy
    
    ActiveWindow.FreezePanes = 
False
'Blattschutz aufheben
With ActiveWorkbook
   
With .Sheets(1)
      .Unprotect Password:=
"xxx"
      
'Kopiert und fügt nur Werte und Formate ein, sperrt komplett
      .Cells.Locked = True
      .Cells.Copy
      .Cells.PasteSpecial Paste:=xlValues
      .Cells.PasteSpecial Paste:=xlFormats
      Application.CutCopyMode = 
False
      .Rows(
"1:2").Delete Shift:=xlUp
      .Range(
"B31").Select
      .Protect Password:=
"xxx"
   
End With
'Code entfernen

Code_loeschen
delNames
' speichert und schließt die neue Mappe
.SaveAs Filename:= _
    
"D:\Temp\" & datname 'C:\Programme\Verein\Archiv-Rechnungen\" & Datname
.Close
End With
Workbooks.Open 
"D:\Temp\" & datname
ActiveWorkbook.Save
ActiveWorkbook.Close
'!!!!!!!!!Ende der Änderungen!!!!!!!!!!!!!!

' Daten der ausgefüllten Rechnung im Tabellenblatt Liste ablegen
    Range("H7").Select
    Sheets(
"Liste").Select
    Cells(Aktzeile, 2).Formula = Aktdat
    Cells(Aktzeile, 3).Formula = Aktknr
    Cells(Aktzeile, 4).Formula = Kundnetto
    Cells(Aktzeile, 5).Formula = Kundmwst
    Cells(Aktzeile, 6).Formula = Kundbrutto
    Cells(Aktzeile, 11).Formula = Kundanrede
    Cells(Aktzeile, 12).Formula = Kundname
    Cells(Aktzeile, 13).Formula = Kundzusatz
    Cells(Aktzeile, 14).Formula = Kundstras
    Cells(Aktzeile, 15).Formula = Kundort
    Cells(Aktzeile, 16).Formula = Smeter
'Original-Rechnung leeren
    Sheets("Rechnung").Select
    Range(
"B33:E46").Select
    Selection.ClearContents
    Range(
"B33").Select
' Blidschirmaktualisierung einschalten
ERRORHANDLER:
    Application.ScreenUpdating = 
True
    Sheets(
"Liste").Select
    Application.DisplayFormulaBar = 
True
    
End If
End Sub
Private Sub Code_loeschen()
   
'Gesamten Code und Module löschen
   'von K.Rola
   Dim myVBComponents As Object
   
If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
   
'sicherheits-check um nicht sich selbst zu löschen
   With ActiveWorkbook.VBProject
      
For Each myVBComponents In .VBComponents
         
Select Case myVBComponents.Type
            
Case 1, 2, 3
               .VBComponents.Remove .VBComponents(myVBComponents.Name)
            
Case 100
               
With myVBComponents.CodeModule
                  .DeleteLines 1, .CountOfLines
               
End With
         
End Select
      
Next
   
End With
End Sub
Private Sub delNames()
Dim myName As Name
If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
For Each myName In ActiveWorkbook.Names
myName.Delete
Next
End Sub 


Gruß Sepp
Anzeige
AW: Danke Ulf und Sepp
10.01.2005 12:26:56
Korl
Hallo Sepp,
ich muß doch noch mal nachhaken. Mir viel auf, als ich Deinen Code geprüft hatte, die Funktion "Option Explicit" vernachlässigt hatte.
Es funktioniert aber trotzdem alles.
Nun war ich am aufräumen und den Code auch in ein separates Modul gelegt mit "Option Explicit"
Nun bleibt er aber hängen. Ich lege noch mal den Code mit rein.

Sub Archivieren()
If Worksheets("Rechnung").Range("F52") = 0 Then
Debug.Print MsgBox("Es wurde noch keine Rechnung erstellt!", 64, "Hinweis")
End If
' erst beginnen wenn der Rechnungsbetrag >0 ist
If Worksheets("Rechnung").Range("F52") > 0 Then
' Bildschirm ausschalten
>>> hier bleibt er hängen <<<<
On erroro GoTo ERRORHANDLER
Application.ScreenUpdating = False
' Name der neuen Arbeitsmappe
Datname = Range("B21")
' aktuelle Zeile für den Eintrag in das Blatt Rechnungen
Aktzeile = Range("C21")
' aktuelles Datum
Aktdat = Range("F26")
' aktuelle Kundennummer
Aktknr = Range("F25")
' Anrede des Kunden
Kundanrede = Range("B14")
' Vorname und Name des Kunden
Kundname = Range("B15")
' Zusatz zum Kunden
Aktzusatz = Range("B16")
' Straße des Kunden
Kundstras = Range("B17")
'Wohnort des Kunden
Kundort = Range("B18")
Smeter = Range("B48")
' Nettobetrag der aktuellen Rechnung
Kundnetto = Range("F49")
' Mwst.-Betrag der aktuellen Rechnung
Kundmwst = Range("F50")
' Bruttobetrag der aktuellen Rechnung
Kundbrutto = Range("F52")
' Wenn man ein einzelnes Tabellenblatt als Workbook speichern will,
' dann geht das direkt, ohne das man vorher ein neues workbook erstellt!
Sheets("Rechnung").Copy
ActiveWorkbook.SaveAs FileName:= _
"C:\Programme\Verein\Archiv-Rechnungen\" & Datname
ActiveWindow.FreezePanes = False
'Blattschutz aufheben
With ActiveWorkbook
With .Sheets(1)
.Unprotect Password:="xxx"
.Protect Contents:=True, UserInterfaceOnly:=True, Password:="xxx"
'Kopiert und fügt nur Werte und Formate ein, sperrt komplett
.Cells.Locked = True
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues
.Cells.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
.Rows("1:2").Delete Shift:=xlUp
.Range("B31").Select
End With
'Code entfernen
Code_loeschen
'Namen Verknüpfungen löschen
delNames
' speichert und schließt die neue Mappe
.Save
.Close
End With
' Daten der ausgefüllten Rechnung im Tabellenblatt Liste ablegen
Range("H7").Select
Sheets("Liste").Select
Cells(Aktzeile, 2).Formula = Aktdat
Cells(Aktzeile, 3).Formula = Aktknr
Cells(Aktzeile, 4).Formula = Kundnetto
Cells(Aktzeile, 5).Formula = Kundmwst
Cells(Aktzeile, 6).Formula = Kundbrutto
Cells(Aktzeile, 11).Formula = Kundanrede
Cells(Aktzeile, 12).Formula = Kundname
Cells(Aktzeile, 13).Formula = Kundzusatz
Cells(Aktzeile, 14).Formula = Kundstras
Cells(Aktzeile, 15).Formula = Kundort
Cells(Aktzeile, 16).Formula = Smeter
'Original-Rechnung leeren
Sheets("Rechnung").Select
Range("B33:E46").Select
Selection.ClearContents
Range("B33").Select
' Blidschirmaktualisierung einschalten
ERRORHANDLER:
Application.ScreenUpdating = True
Sheets("Liste").Select
Application.DisplayFormulaBar = True
End If
End Sub

Nun habe ich ja Variable mit eingebaut, müssen diese in eine "DIM" Funktion gebaut werden?
Da es ohne "Option Explicit" läuft, kann dieses dann auch vernachlässigt werden?

Gruß Korl
Anzeige
AW: Danke Ulf und Sepp
10.01.2005 12:45:05
Josef
Hallo Korl!
Grundsätzlich sollte man immer mit Expliziter Variablendeklaration arbeiten.
Erstens, weil sich so Fehler durch falsch geschriebene Variablen vermeiden lassen,
und zweitens weil der Code dadurch übersichtlicher und auch schneller wird!
Schau dir dazu mal die xlBasics von Hans an. http://xlfaq.herber.de/
Gruß Sepp
Oh,Oh, ich muß mich belesen
10.01.2005 14:37:40
Korl
Hallo Sepp,
vielen Dank für Deine Unterstützung und Deinen Hinweise.
Bei jedem recherchieren nehme ich ein Stück Wissen mit, muß mich aber trotzdem erstmal konzentriert belesen.
Mein großes Problem ist auch die Sprache dabei. Habe kein englisch gelernt.
Danke nochmal!
Gruß Korl
bei wechsel der Systeme Problem
10.01.2005 15:21:45
Korl
Hallo Sepp,
wenn ich meine Excelmappe von 97 in Excel 2002 laufen lasse bleibt er beim o.g. Code
während dieses Makro mit der Fehlermeldung "Der programmatischer Zugriff auf das VBA ist nicht sicher" stehen.
Public

Sub Code_loeschen()
'Gesamten Code und Module löschen
'von K.Rola
Dim myVBComponents As Object
If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
'sicherheits-check um nicht sich selbst zu löschen
With ActiveWorkbook.VBProject
For Each myVBComponents In .VBComponents
Select Case myVBComponents.Type
Case 1, 2, 3
.VBComponents.Remove .VBComponents(myVBComponents.Name)
Case 100
With myVBComponents.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
End With
End Sub

SAepp, kannst Du mir ein letztes mal hierbei helfen?
Gruß Korl

AW: bei wechsel der Systeme Problem
10.01.2005 15:52:59
Josef
Hallo Korl!
Schau mal unter "Sicherheit" ob der Zugriff auf das VBA Projekt zugelassen ist!
Gruß Sepp
das war es, Danke Sepp
10.01.2005 16:37:11
Korl
Hallo Sepp,
wiedermal Danke für Deinen Tipp. Das wars!
Gruß Korl

41 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige