Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1116to1120
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1116to1120
1116to1120
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA hält sich nicht an die regeln

VBA hält sich nicht an die regeln
alex
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
nur ein Verdacht,...
18.11.2009 08:32:06
Tino
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
AW: nur ein Verdacht,...
18.11.2009 15:44:42
alex
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?
Anzeige
sorry, frage ist noch offen!
18.11.2009 16:20:51
alex
die frage ist noch offen
vrsuche mal beide Varianten,...
18.11.2009 16:27:34
Tino
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
AW: vrsuche mal beide Varianten,...
18.11.2009 19:50:10
alex
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
Anzeige
Application.Run
18.11.2009 20:02:10
Tino
Hallo,
müsste so gehen
Application.Run "wartung.xls!quartalswartung_schreiben"
oder auch so
Application.Run "wartung.xls!Modul1.quartalswartung_schreiben"
Gruß Tino
AW: Application.Run
18.11.2009 20:26:10
alex
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.
AW: Application.Run
18.11.2009 20:45:28
alex
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

Anzeige
AW: Application.Run
18.11.2009 20:53:58
Tino
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
Anzeige
AW: Application.Run
18.11.2009 21:14:58
alex
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
Anzeige
AW: Application.Run
18.11.2009 21:25:29
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^^
AW: Application.Run
18.11.2009 21:32:52
alex
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

Anzeige
na super, gewusst u. nicht daran gedacht oT.
18.11.2009 21:40:41
Tino
AW: Application.Run
18.11.2009 21:29:20
Tino
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
Anzeige
AW: Application.Run
18.11.2009 21:42:14
alex
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

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige