Makro startet automatisch wieder?
10.08.2018 09:42:52
Torsten
habe wieder mal ein kleines Problemchen. Zur Lage:
Unten werde ich die Makros anzeigen.
Ich mache per SendKeys 3 verschiedene Listenabfragen ( Makros SAP_call_21G_1, SAP_call_21G_2, SAP_call_local) in SAP. Diese Listen kopiere ich ueber die Zwischenablage in meine Exceldatei in ein speziell angelegtes Sheet dafuer. Nachdem die 3 Listen dort eingefuegt sind, starte ich automatisch das Makro zum Zaehlen der Zeilen (Makro count_new_lines) fuer die jeweilige PG (gezaehlt wird in Spalte N in Sheet "Clipboard"). Diese werden dann in der richtigen Spalte und Zeile im Sheet "Dashboard" eingefuegt.
Bis dahin funktioniert das auch wunderbar. Habe am Schluss eine Msgbox eingefuegt, damit der Benutzer weiss, dass der Vorgang abgeschlossen ist.
Jetzt kommt mein Problem:
Nach klick auf OK in der Msgbox werden die gerade gemachten Eintraege wieder geloescht und es startet immer automatisch wieder das Makro SAP_call_local und ich hab keine Idee, warum das passiert.
Kann mir jemand sagen, warum das kommt?
Hier die Codes:
Option Explicit
Sub SAP_call_21G_1()
AppActivate ("Dynamic availability check, display table contents from ZMM_ZDAC")
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "+{F5}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys ("21G_MISS_1_NEW"), True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{DOWN 2}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "+{End}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{Delete}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{F8}", True
Application.Wait (Now + TimeValue("0:00:05"))
SendKeys "{F8}", True
Application.Wait (Now + TimeValue("0:00:30"))
SendKeys "^{a}", True
Application.Wait (Now + TimeValue("0:00:06"))
SendKeys "^{c}", True
Application.Wait (Now + TimeValue("0:00:02"))
On Error GoTo errorhandler
With ThisWorkbook.Sheets("CLIPBOARD")
.Cells(1, 1).PasteSpecial
End With
Call SAP_call_21G_2
errorhandler: Call SAP_call_21G_2
End Sub
Sub SAP_call_21G_2()
AppActivate ("Dynamic availability check, display table contents from ZMM_ZDAC")
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{F3}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "+{F5}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys ("21G_MISS_2_NEW"), True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{DOWN 2}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "+{End}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{Delete}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{F8}", True
Application.Wait (Now + TimeValue("0:00:05"))
SendKeys "{F8}", True
Application.Wait (Now + TimeValue("0:00:30"))
SendKeys "^{a}", True
Application.Wait (Now + TimeValue("0:00:06"))
SendKeys "^{c}", True
Application.Wait (Now + TimeValue("0:00:02"))
On Error GoTo errorhandler
With ThisWorkbook.Sheets("CLIPBOARD")
.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
End With
Call SAP_call_local
errorhandler: Call SAP_call_local
End Sub
Sub SAP_call_local()
AppActivate ("Dynamic availability check, display table contents from ZMM_ZDAC")
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{F3}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "+{F5}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys ("TW_LOCAL_MISS"), True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{DOWN 2}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "+{End}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{Delete}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{F8}", True
Application.Wait (Now + TimeValue("0:00:05"))
SendKeys "{F8}", True
Application.Wait (Now + TimeValue("0:00:30"))
SendKeys "^{a}", True
Application.Wait (Now + TimeValue("0:00:06"))
SendKeys "^{c}", True
Application.Wait (Now + TimeValue("0:00:02"))
On Error GoTo errorhandler
With ThisWorkbook.Sheets("CLIPBOARD")
.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
End With
Call count_new_lines
errorhandler: Call count_new_lines
End Sub
Option Explicit
Sub count_new_lines()
Dim WSSource As Worksheet: Set WSSource = Worksheets("CLIPBOARD")
Dim WSTarget As Worksheet: Set WSTarget = Worksheets("Dashboard")
Dim val As String, tDate As String
Dim cnt As Long, fstRow As Long, lstRow As Long
Dim Srng As Range, tRow As Range, tColumn As Range, PGrng As Range
Set Srng = WSSource.Range("N:N")
For Each PGrng In WSTarget.Range("A191:A203")
val = PGrng.Value
cnt = WorksheetFunction.CountIf(Srng, val)
tDate = Format(Date, "dd")
Set tRow = WSTarget.Columns(31).Find(What:=val, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set tColumn = WSTarget.Rows(3).Find(What:=tDate, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Cells(tRow.Row, tColumn.Column).Value = cnt
Next
WSSource.UsedRange.Rows.EntireRow.Delete
AppActivate (Application.Caption)
MsgBox "Daily income finished"
ThisWorkbook.Save
WSTarget.Activate
WSTarget.Range("A1").Select
End Sub
https://www.herber.de/bbs/user/123252.xlsm
Gruss und Danke
Torsten