AW: Der Hintergrund ...
11.11.2018 18:09:57
Mullit
Hallo Matthias,
ja gut, da hast Du jetzt 'n paar Zusatzinfos hinterhergeschoben...;-)...Ist jetzt so'n bißchen die Frage, ob man das braucht, denn um die Apis wirst Du da nicht umherkommen, aber ok...
Ich hab hier 'n Bsp. das i. Pr. läuft, da wird allerdings die ErrNumber im Timer abgefragt, da Du ja auf Verdacht die Dialoge öffnen willst, das könnte so'n bißchen Bauchschmerzen verursachen, besser wär's wohl, Du gehst vorher ein fixe Liste mit den Konstanten der mögl. Dialoge durch und vermeidest den erzw. Fehler...
' **********************************************************************
' Modul: Tabelle1 Typ: Klassenmodul des Tabellenblattes
' **********************************************************************
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 2 Then '// Doppelclickevent feuert hier nur in Sp. 2, mußt Du bei Bedarf ändern...////
Cancel = True
Call test(Target.Row)
End If
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Standardmodul
' **********************************************************************
Option Explicit
Private Declare Function GetWindowTextA Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function GetWindowTextLengthA Lib "user32.dll" ( _
ByVal hWnd As Long) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private llngRow As Long
Private llngErrNumber As Long
Public Sub test(ByVal pvlngRow As Long)
llngRow = pvlngRow
Call prcStartTimer
On Error Resume Next
Call Application.Dialogs(pvlngRow).Show
llngErrNumber = Err.Number
End Sub
Private Sub prcStartTimer()
Call SetTimer(Application.hWnd, 0&, 10&, AddressOf TimerProc)
End Sub
Private Sub prcStopTimer()
Call KillTimer(Application.hWnd, 0&)
End Sub
Private Sub TimerProc(ByVal pvlngHwnd As Long, ByVal pvlngnIDEvent As Long, _
ByVal pvlnguElapse As Long, ByVal pvlnglpTimerFunc As Long)
Static sstrTemp As String
Static slngHwnd1 As Long
Dim lngTextLength As Long
If llngErrNumber = 0 Then
If slngHwnd1 = 0 Then
slngHwnd1 = GetActiveWindow
If slngHwnd1 <> 0 Then
If sstrTemp = vbNullString Then
lngTextLength = GetWindowTextLengthA(slngHwnd1)
sstrTemp = Space$(lngTextLength)
Call GetWindowTextA(slngHwnd1, sstrTemp, lngTextLength + 1)
End If
Else
Call prcStopTimer
Call MsgBox("Das Fenster wurde nicht gefunden....!", vbExclamation)
sstrTemp = vbNullString
slngHwnd1 = 0
End If
ElseIf slngHwnd1 <> GetActiveWindow Then
Call prcStopTimer
Cells(llngRow, 1).Value = sstrTemp
sstrTemp = vbNullString
slngHwnd1 = 0
End If
Else
Call prcStopTimer
sstrTemp = vbNullString
slngHwnd1 = 0
llngErrNumber = 0
Call MsgBox("Dialog nicht vorhanden....!", vbExclamation)
End If
End Sub
VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel
Code erstellt und getestet in Office 12
Gruß, Mullit
