Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

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


Betrifft: VBA hält sich nicht an die regeln von: alex
Geschrieben am: 18.11.2009 07:55:16

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

  

Betrifft: AW: VBA hält sich nicht an die regeln von: alex
Geschrieben am: 18.11.2009 08:28:00

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


  

Betrifft: nur ein Verdacht,... von: Tino
Geschrieben am: 18.11.2009 08:32:06

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


  

Betrifft: AW: nur ein Verdacht,... von: alex
Geschrieben am: 18.11.2009 15:44:42

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???


  

Betrifft: sorry, frage ist noch offen! von: alex
Geschrieben am: 18.11.2009 16:20:51

die frage ist noch offen


  

Betrifft: vrsuche mal beide Varianten,... von: Tino
Geschrieben am: 18.11.2009 16:27:34

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


  

Betrifft: AW: vrsuche mal beide Varianten,... von: alex
Geschrieben am: 18.11.2009 19:50:10

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


  

Betrifft: Application.Run von: Tino
Geschrieben am: 18.11.2009 20:02:10

Hallo,
müsste so gehen

Application.Run "wartung.xls!quartalswartung_schreiben"

oder auch so

Application.Run "wartung.xls!Modul1.quartalswartung_schreiben"


Gruß Tino


  

Betrifft: AW: Application.Run von: alex
Geschrieben am: 18.11.2009 20:26:10

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.


  

Betrifft: AW: Application.Run von: alex
Geschrieben am: 18.11.2009 20:45:28

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



  

Betrifft: AW: Application.Run von: Tino
Geschrieben am: 18.11.2009 20:53:58

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


  

Betrifft: AW: Application.Run von: alex
Geschrieben am: 18.11.2009 21:14:58

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


  

Betrifft: AW: Application.Run von: alex
Geschrieben am: 18.11.2009 21:25:29

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^^


  

Betrifft: AW: Application.Run von: alex
Geschrieben am: 18.11.2009 21:32:52

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



  

Betrifft: na super, gewusst u. nicht daran gedacht oT. von: Tino
Geschrieben am: 18.11.2009 21:40:41




  

Betrifft: AW: Application.Run von: Tino
Geschrieben am: 18.11.2009 21:29:20

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


  

Betrifft: AW: Application.Run von: alex
Geschrieben am: 18.11.2009 21:42:14

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