Thema: VBA hält sich nicht an die regeln | Herbers Excel-Forum

kann mir jemand erklären warum dieses Makro
Sub Speichern()
'
' Speichern Makro
'
ActiveWorkbook.Save
End Sub in Verbindung mit diesem Makro

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call quartalswartung_schreiben
Call akkudatum
End Sub

nur teilweise die Makros quartalswartung_schreiben und akkudatum ausführt obwohl die beiden makros komplett ausgeführt werden wenn ich über den excelbutton speicher (blaue diskette) bzw wenn ich die makros direkt ausführe.
bin mit den nerven langsam am ende
danke
sub quartalswartung_schreiben ()
t = ThisWorkbook.Sheets("kt").Cells(11, 3)
s = ThisWorkbook.Sheets("kt").Cells(3, 5)
On Error Resume Next
Workbooks("wartung.xls").Activate
strPath = ThisWorkbook.Path
ChDrive Left(strPath, 2)
ChDir strPath
If Err <> 0 Then
Workbooks.Open ("../../wartung.xls")
End If
With Workbooks("wartung.xls").Sheets("Vertrieb").Range("b1:d1000")
Set c = .Find(t, LookAT:=xlWhole)
If c.Offset(0, 2) <> s Then
With Range(c.Offset(0, 2), c.Offset(1, 2))
Set d = .Find(s, LookAT:=xlWhole)
If d <> s Then
With Range(c.Offset(1, 2), c.Offset(2, 2))
Set e = .Find(s, LookAT:=xlWhole)
If e <> s Then
With Range(c.Offset(2, 2), c.Offset(3, 2))
Set f = .Find(s, LookAT:=xlWhole)
f.Offset(0, 3) = ThisWorkbook.Sheets("werte").Cells(1, 1) 'WIRD NICHT AUSGEFÜHRT
f.Offset(0, 4) = ThisWorkbook.Sheets("werte").Cells(1, 2) 'WIRD NICHT AUSGEFÜHRT
f.Offset(0, 5) = ThisWorkbook.Sheets("werte").Cells(1, 3) 'WIRD NICHT AUSGEFÜHRT
f.Offset(0, 6) = ThisWorkbook.Sheets("werte").Cells(1, 4) 'WIRD NICHT AUSGEFÜHRT
f.Offset(0, -2).Hyperlinks.Add Anchor:=f.Offset(0, -2), Address:=ThisWorkbook.FullName, TextToDisplay:=ThisWorkbook.Sheets("kt").Cells(11, 3).Text
f.Offset(0, -2).Font.Underline = xlUnderlineStyleNone 'WIRD NICHT AUSGEFÜHRT
f.Offset(0, -2).Font.ColorIndex = 0 'WIRD NICHT AUSGEFÜHRT
End With
Else
e.Offset(0, 3) = ThisWorkbook.Sheets("werte").Cells(1, 1) 'WIRD NICHT AUSGEFÜHRT
e.Offset(0, 4) = ThisWorkbook.Sheets("werte").Cells(1, 2) 'WIRD NICHT AUSGEFÜHRT
e.Offset(0, 5) = ThisWorkbook.Sheets("werte").Cells(1, 3) 'WIRD NICHT AUSGEFÜHRT
e.Offset(0, 6) = ThisWorkbook.Sheets("werte").Cells(1, 4) 'WIRD NICHT AUSGEFÜHRT
e.Offset(0, -2).Hyperlinks.Add Anchor:=e.Offset(0, -2), Address:=ThisWorkbook.FullName, TextToDisplay:=ThisWorkbook.Sheets("kt").Cells(11, 3).Text
e.Offset(0, -2).Font.Underline = xlUnderlineStyleNone 'WIRD NICHT AUSGEFÜHRT
e.Offset(0, -2).Font.ColorIndex = 0 'WIRD NICHT AUSGEFÜHRT
End If
End With
Else
d.Offset(0, 3) = ThisWorkbook.Sheets("werte").Cells(1, 1) 'WIRD NICHT AUSGEFÜHRT
d.Offset(0, 4) = ThisWorkbook.Sheets("werte").Cells(1, 2) 'WIRD NICHT AUSGEFÜHRT
d.Offset(0, 5) = ThisWorkbook.Sheets("werte").Cells(1, 3) 'WIRD NICHT AUSGEFÜHRT
d.Offset(0, 6) = ThisWorkbook.Sheets("werte").Cells(1, 4) 'WIRD NICHT AUSGEFÜHRT
d.Offset(0, -2).Hyperlinks.Add Anchor:=d.Offset(0, -2), Address:=ThisWorkbook.FullName, TextToDisplay:=ThisWorkbook.Sheets("kt").Cells(11, 3).Text
d.Offset(0, -2).Font.Underline = xlUnderlineStyleNone 'WIRD NICHT AUSGEFÜHRT
d.Offset(0, -2).Font.ColorIndex = 0 'WIRD NICHT AUSGEFÜHRT
End If
End With
Else
c.Offset(0, 5) = ThisWorkbook.Sheets("werte").Cells(1, 1) 'WIRD NICHT AUSGEFÜHRT
c.Offset(0, 6) = ThisWorkbook.Sheets("werte").Cells(1, 2) 'WIRD NICHT AUSGEFÜHRT
c.Offset(0, 7) = ThisWorkbook.Sheets("werte").Cells(1, 3) 'WIRD NICHT AUSGEFÜHRT
c.Offset(0, 8) = ThisWorkbook.Sheets("werte").Cells(1, 4) 'WIRD NICHT AUSGEFÜHRT
c.Offset(0, 0).Hyperlinks.Add Anchor:=c.Offset(0, 0), Address:=ThisWorkbook.FullName, TextToDisplay:=ThisWorkbook.Sheets("kt").Cells(11, 3).Text
c.Offset(0, 0).Font.Underline = xlUnderlineStyleNone 'WIRD NICHT AUSGEFÜHRT
c.Offset(0, 0).Font.ColorIndex = 0 'WIRD NICHT AUSGEFÜHRT
End If
End With
Err.Clear
ThisWorkbook.Activate
Application.ScreenUpdating = True
End Sub

https://www.herber.de/bbs/user/65997.zip

Hallo,
vielleicht ist die aktive Datei nicht die wo das Eventmakro ausgeführt wird.
Versuche es mal mit ThisWorkbook.Save
Oder als letzten Ausweg ohne das Eventmakro.

Sub Speichern()
Application.EnableEvents = False
Call quartalswartung_schreiben
Call akkudatum
ActiveWorkbook.Save
Application.EnableEvents = True
End Sub

Gruß Tino

Hallo tino
erstmal danke für deine antwort.
ohne das event makro funktioniert der code...das hatte ich schon versucht, und ich bin auch am überlegen ob ich es so mache....ich wollte aber eigentlich meinen kollegen die wahl lassen ob sie die blaue diskette zum speichern benutzen oder den selbst erstellten speichern button . außerdem gibt es in der wartung.xls (in meiner version). eine update funktion die sämmtliche mappen öffnet kopiert, speichert und schließt(falls es mal änderungen an den vorlagen gibt). eigentlich hätte ich gerne das damit dann auch gleich die hyperlinks gesetzt werden und die wartung in die wartung.xls geschrieben wird(falls vorhanden). wenn ich kein event makro habe dann müßte ich irgendwie das makro "quartalswartung_schreiben" aus der wartung.xls ausführen.
leider weiß ich nicht wie ich ein makro aus einer anderen mappe starte.
thisworkbook.save geht leider auch nicht. hatte ich heute früh mal ausprobiert.
ich frage mich echt wo der unterschied zwischen der blauen diskette zum speichern und activeworkbook.save ist?

die frage ist noch offen

Hallo,
so einzubauen und teste mal ob es funktioniert.

Sub Speichern()
Application.EnableEvents = False
Call quartalswartung_schreiben
Call akkudatum
ActiveWorkbook.Save
Application.EnableEvents = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Call quartalswartung_schreiben
Call akkudatum
Application.EnableEvents = True
End Sub

Gruß Tino

nein sorry funktioniert auch nicht....zumindest nicht mit dem *.save befehl aus meinem vorlagen update.
innerhalb der mappe gehts. aber da reichts auch schon wenn man Application.EnableEvents = False
im speichern sub setzt.
ich versuche gerade das quartalsmakro über application.run aus der wartung.xls zu starten.
aber wie muß denn die syntax sein damit der datei name variabel ist.
ich habs mit
Application.Run (wbkQ & "!quartalswartung_schreiben")
versucht aber irgendwie bekomme ich da einen fehler

Hallo,
müsste so gehen
Application.Run "wartung.xls!quartalswartung_schreiben"
oder auch so
Application.Run "wartung.xls!Modul1.quartalswartung_schreiben"
Gruß Tino

nein der datei name muß variabel sein oder irre ich mich da, weil das makro quartalswartung_schreiben in den anderen dateien steht. aber nicht in der wartung.xls.

ich habe das in der wartung.xls stehen und will mit dem makro auf ein makro einer andere datei zugreifen dessen name variiert.
so gehts auf jedenfall nicht:

Private Sub CommandButton16_Click()
Dim strDatei As String, wbkQ As Workbook     ' Quellen
Dim activ As String
Dim mak As String
activ = ActiveWorkbook.name
mak = activ & "!modul2.quartalswartung_schreiben"
Const Pfad = "C:\Wartungslisten\Wartung  Aktuell\BMA\Netz"
strDatei = Dir(Pfad & "\" & "*.xls")
Application.ScreenUpdating = False
Application.EnableEvents = False
Do Until strDatei = ""
strDatei = Pfad & "\" & strDatei
Set wbkQ = Workbooks.Open(strDatei)
With wbkQ
Application.Run mak
wbkQ.Close False
End With
strDatei = Dir()
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Hallo,
ich denke wenn Du auf den Button drückst, ist die aktive aber wartung.xls und nicht die andere.
Versuche es mal so

Private Sub CommandButton16_Click()
Dim strDatei As String, wbkQ As Workbook     ' Quellen
Dim activ As String
Dim mak As String
Const Pfad = "C:\Wartungslisten\Wartung  Aktuell\BMA\Netz"
If LCase(Workbooks(1).Name) = "wartung.xls" Then
activ = Workbooks(2).Name
Else
activ = Workbooks(1).Name
End If
mak = activ & "!modul2.quartalswartung_schreiben"
strDatei = Dir(Pfad & "\" & "*.xls")
Application.ScreenUpdating = False
Application.EnableEvents = False
Do Until strDatei = ""
strDatei = Pfad & "\" & strDatei
Set wbkQ = Workbooks.Open(strDatei)
With wbkQ
Application.Run mak
wbkQ.Close False
End With
strDatei = Dir()
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Gruß Tino

erstmal will ich mich nochmal bei dir bedanken das du dir so viel mühe mit meinem makro(s) gibst.
hast recht. ich hab das activ jetzt tiefer gesetzt.
dein code funktioniert leider nicht.
ich habs jetzt so

Private Sub CommandButton16_Click()
Dim strDatei As String, wbkQ As Workbook     ' Quellen
Dim activ As String
Dim mak As String
Const Pfad = "C:\Wartungslisten\Wartung  Aktuell\BMA\Netz"
strDatei = Dir(Pfad & "\" & "*.xls")
Application.ScreenUpdating = False
Application.EnableEvents = False
Do Until strDatei = ""
strDatei = Pfad & "\" & strDatei
Set wbkQ = Workbooks.Open(strDatei)
activ = ActiveWorkbook.name
With wbkQ
Application.Run (activ & "!quartalswartung_schreiben")
wbkQ.Close False
End With
strDatei = Dir()
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

aber es geht auch nicht
ich bekomm immer objekt oder anwendungsdefinierter fehler.
heute ist irgendwie nicht mein tag^^
gruß alex

man glaubt es kaum aber es liegt am leerzeichen im dateinamen....
in der variable activ steht Adlershof ESTW.xls.
ich hab die datei einfach mal spasseshalber umbenant in AdlershofESTW.xls und das makro funktioniert....
ich hab jetzt 2 möglichkeiten. entweder ich benenne jetzt 600 dateien um oder jemand zeigt mir wie ich die leerzeichen im dateinamen bei application.run lassen kann^^

juhu es klappt
hab diesen code im netz gefunden. damit kann man auch leerzeichen im datei namen haben

Private Sub CommandButton16_Click()
Dim strDatei As String, wbkQ As Workbook     ' Quellen
Dim activ As String
Const Pfad = "C:\Wartungslisten\Wartung  Aktuell\BMA\Netz"
strDatei = Dir(Pfad & "\" & "*.xls")
Application.ScreenUpdating = False
Application.EnableEvents = False
Do Until strDatei = ""
strDatei = Pfad & "\" & strDatei
Set wbkQ = Workbooks.Open(strDatei)
activ = ActiveWorkbook.name
With wbkQ
Application.Run ("'" & Workbooks(activ).name & "'!quartalswartung_schreiben") 'DAS IST DER CODE
wbkQ.Close False
End With
strDatei = Dir()
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Hallo,
verstehen kann ich es nicht warum es nicht geht.
Habe aber jetzt erst gesehen das Du beim öffnen die Datei an eine Variable übergibst
in dieser steckt schon der Name der Datei, daher activ brauchen wir nicht.

Private Sub CommandButton16_Click()
Dim strDatei As String, wbkQ As Workbook     ' Quellen
Dim mak As String
Const Pfad = "C:\Wartungslisten\Wartung  Aktuell\BMA\Netz"
strDatei = Dir(Pfad & "\" & "*.xls")
Application.ScreenUpdating = False
Application.EnableEvents = False
Do Until strDatei = ""
strDatei = Pfad & "\" & strDatei
Set wbkQ = Workbooks.Open(strDatei)
With wbkQ
Application.Run wbkQ.Name & "!quartalswartung_schreiben"
wbkQ.Close False
End With
strDatei = Dir()
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Sollte es nicht gehen, müsstest Du mal zwei abgespeckte Dateien als zip hochladen,
dann sehe ich bestimmt besser wo der Fehler steckt und kann auch selbst testen.
Gruß Tino

danke für deine mühe tino.
es lag am leerzeichen im dateinamen.
schau mal ein beitrag weiter drüber dort steht der richtige code.
man kann scheinbar nicht einfachso dateinamen mit leerzeichen in application.run benutzen.
war purer zufall das ich das rausgefunden habe.
aber trotzdem
tausend dank nochmal für deine hilfe
gruß alex