ich hab folgendes Problem:
Die Datei soll im Hintergrund laufen und falls die MessageBox aufgeht in der Taskleiste blinken. Wenn ich die Einzelschritte mache von dem FlashWindow -Teil funktioniert es auch, jedoch nicht wenn ich die Makros komplett starte.
Kann mir einer sagen woran das liegen könnte oder wie man es anders lösen kann.
Vielen Dank schonmal
Hier der komplette VBA Code:
'********************************************
'Timer deklaration
Option Explicit
Dim iTimerSet As Double
Public Sub StartEs()
iTimerSet = Now + TimeValue("00:02:00")
Application.OnTime iTimerSet, "Auftragstool"
End Sub
Public Sub StopEs()
Application.OnTime iTimerSet, "Auftragstool", , False
End Sub
'Hauptaufrufe mit Timer start
Public Sub Auftragstool()
Call Import
Call Nullserien
Call StartEs
End Sub
Public Sub Import()
'Import von SAP Daten und autom. Formatierung
Dim ActiveWorkbook As String
ActiveWorkbook = "Auftragstool_v08.xlsm"
Workbooks(ActiveWorkbook).Worksheets("Tabelle3").Activate
Range("A1:ZZ2300").ClearContents
Range("A1:ZZ2300").ClearContents
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;**********.txt", Destination:=Range("$A$1"))
.Name = "FBH_ORDFULF_DU_FTBT"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 5
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(9, 1, 1, 1, 9, 9, 1, 1, 1, 1, 1, 2, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-27
Call Fertige_auftraege
Call auftraege_löschen
End Sub
'Fertige Aufträge suchen und Zeile löschen
Private Sub Fertige_auftraege()
Dim lz As Integer, g As Integer
lz = Cells(Rows.Count, 1).End(xlUp).Rows.Row
For g = lz To 2 Step -1
If Cells(g, 4).Value = Cells(g, 7).Value Then
Rows(g).Delete Shift:=xlUp
End If
Next g
End Sub
'Geholte Aufträge suchen und Zeile löschen
Private Sub auftraege_löschen()
Dim lz As Integer, t As Integer, a As Integer
Dim p As Integer
Dim ActiveWorkbook As String
ActiveWorkbook = "Auftragstool_v08.xlsm"
Workbooks.Open Filename:="**********checked.xlsx"
lz = Workbooks(ActiveWorkbook).Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Rows. _
Row
a = 2
For t = lz To 2 Step -1
Do While Workbooks("checked.xlsx").Worksheets("Tabelle1").Cells(a, 1).Value 0
If Workbooks(ActiveWorkbook).Worksheets("Tabelle3").Cells(t, 2).Value = Workbooks(" _
checked.xlsx").Worksheets("Tabelle1").Cells(a, 1).Value Then
Workbooks(ActiveWorkbook).Worksheets("Tabelle3").Rows(t).Delete Shift:=xlUp
End If
a = a + 1
Loop
a = 2
Next t
Workbooks("checked.xlsx").Close SaveChanges:=True
End Sub
'********************************************
'Blinken des Tasks
Option Explicit
Private Declare Function FlashWindowEx Lib "user32.dll" ( _
ByRef pfwi As FLASHWINFO) As Boolean
Public Const FLASHW_STOP = &H0
Public Const FLASHW_CAPTION = &H1
Public Const FLASHW_TRAY = &H2
Public Const FLASHW_ALL = &H3
Public Const FLASHW_TIMER = &H4
Public Type FLASHWINFO
cbSize As Long
hwnd As Long
dwFlags As Long
uCount As Long
dwTimeout As Long
End Type
Public ludtFlashInfo As FLASHWINFO
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Sub Flash_On()
Dim hwnd As Long
With ludtFlashInfo
ludtFlashInfo.cbSize = Len(ludtFlashInfo)
ludtFlashInfo.dwFlags = FLASHW_TRAY
ludtFlashInfo.dwTimeout = 250 'Intervall in Millisekunden
ludtFlashInfo.hwnd = FindWindow("XLMAIN", "Microsoft Excel - Auftragstool_V08.xlsm")
ludtFlashInfo.uCount = 500
End With
Call FlashWindowEx(ludtFlashInfo)
End Sub
Public Sub Flash_Off()
ludtFlashInfo.dwFlags = FLASHW_STOP
Call FlashWindowEx(ludtFlashInfo)
End Sub
Sub Blinken_an()
Call Flash_On
End Sub
Sub Blinken_aus()
Call Flash_Off
End Sub
'Nullserien erkennen und MessageBox ausgeben
Public Sub Nullserien()
Dim Zeile As Integer, n As Integer, Antwort As Integer, last_cell As Integer
Dim ActiveWorkbook As String
ActiveWorkbook = "Auftragstool_v08.xlsm"
Zeile = Workbooks(ActiveWorkbook).Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Rows. _
_
Row
For n = Zeile To 2 Step -1
If Workbooks(ActiveWorkbook).Worksheets("Tabelle3").Cells(n, 9).Value = "0001" Or _
Workbooks(ActiveWorkbook).Worksheets("Tabelle3").Cells(n, 9).Value = "0032" Then
Call Blinken_an
Antwort = MsgBox("Eine Vor-/Nullserie ist am Band " & Workbooks(ActiveWorkbook). _
Worksheets("Tabelle3").Cells(n, 1).Value & " zu holen! Holen Sie die?", vbYesNo, "Vor-/ _
Nullserie")
If Antwort = "6" Then
Workbooks.Open Filename:="****checked.xlsx"
Workbooks("checked.xlsx").Worksheets("Tabelle1").Cells(Rows.Count, "A").End( _
xlUp).Offset(1).Value = Workbooks(ActiveWorkbook).Worksheets("Tabelle3").Cells(n, 2).Value
Workbooks("checked.xlsx").Close SaveChanges:=True
End If
Call Blinken_aus
End If
Next n
End Sub