Hallo Ineteressierte,
Nepumuk hat wieder gezaubert
wenn man im nachfolgenden Code die prozedur „Aufruf“ ausführt erscheint eine Msgbox mit drei Schaltflächen die die Aufschriften „Hallo“, Dirk" und „Dubai“ und die Msgbox hat den Titel „Titel“, also alles Dinge die man im Code selbst bestimmen kann.
In Excel-Vba läuft das wunderbar.
In VB5.0 kommt der Debugger bei
If Val(Application.Version) > 9 Then
und stört sich an „Application.Version“
9 entspricht Excel2000.
(8=XL97, 9=XL2000, 10= XL2002, usw.)
Im restlichen Code konnte ich nichts Excelspezielles sehen.
Ich gehe erstmal davon aus, man muß nur diese Zeile auf VB umstellen:
llngHwnd = FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
Und ob man die IF-Abfrage braucht in Vb weiß ich auch nicht. XL2000 (Version 9.0) beruht auf VB6.0, XL97 (version 8.0) beruht auf VB5.0.
Von daher hätte es für mich mehr Sinn gemacht wenn Nepumuk auf >8 abgeprüft hätte.
Aber ich sah noch nie Code von Nepumuk der nicht funktionierte, also ist >9 garantiert korrekt.
Was Vbler vielleicht nicht wissen, wenn man in höheren Versionen als XL2000 im Editor auf Info klickt, steht dann da VB6.5.
Soweit ich weiß gabs aber nie eine VB 6.5 Version.
Caption ist ja der Titel des Fensters, wie lautet der für ein VB-FEnster?
Und „GC_CLASSNAMEMSEXCEL“, da habe ich Null Plan das auf VB umzuwechseln.
Danke ^ Gruß
Reinhard
Option Explicit
'
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( \_
ByVal lpClassName As String, \_
ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32.dll" ( \_
ByVal Hwnd As Long, \_
ByVal nIDEvent As Long, \_
ByVal uElapse As Long, \_
ByVal lpTimer As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( \_
ByVal Hwnd As Long, \_
ByVal nIDEvent As Long) As Long
Private Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" ( \_
ByVal Hwnd As Long, \_
ByVal lpText As String, \_
ByVal lpCaption As String, \_
ByVal wType As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32.dll" Alias "SendDlgItemMessageA" ( \_
ByVal hDlg As Long, \_
ByVal nIDDlgItem As Long, \_
ByVal wMsg As Long, \_
ByVal wParam As Long, \_
ByVal lParam As String) As Long
Private Const TIMER\_ID = 0
Private Const TIMER\_ELAPSE = 25
Private Const WM\_SETTEXT = &HC
Private Const GC\_CLASSNAMEMSEXCEL = "XLMAIN"
Private Const GC\_CLASSNAMEMSDIALOGS = "#32770"
Private lstrButtonCaption1 As String
Private lstrButtonCaption2 As String
Private lstrButtonCaption3 As String
Private lstrBoxTitel As String
Private llngHwnd As Long
Private Function MsgBox\_Plus( \_
ByVal strText As String, \_
ByVal strTitle As String, \_
ByVal strButtonText1 As String, \_
Optional ByVal strButtonText2 As String, \_
Optional ByVal strButtonText3 As String, \_
Optional ByVal enmStyle As VbMsgBoxStyle) As Long
Dim lngResult As Long
lstrButtonCaption1 = strButtonText1
lstrButtonCaption2 = strButtonText2
lstrButtonCaption3 = strButtonText3
lstrBoxTitel = strTitle
If Val(Application.Version) \> 9 Then
llngHwnd = Application.Hwnd
Else
llngHwnd = FindWindow(GC\_CLASSNAMEMSEXCEL, Application.Caption)
End If
Call SetTimer(llngHwnd, TIMER\_ID, TIMER\_ELAPSE, AddressOf Set\_Button\_Text)
If lstrButtonCaption2 = "" And lstrButtonCaption3 = "" Then
lngResult = MessageBox(llngHwnd, strText, strTitle, vbOKOnly Or enmStyle)
ElseIf lstrButtonCaption2 "" And lstrButtonCaption3 = "" Then
lngResult = MessageBox(llngHwnd, strText, strTitle, vbYesNo Or enmStyle)
Else
lngResult = MessageBox(llngHwnd, strText, strTitle, vbAbortRetryIgnore Or enmStyle)
End If
If lngResult = 1 Or lngResult = 3 Or lngResult = 6 Then
MsgBox\_Plus = 1
ElseIf lngResult = 4 Or lngResult = 7 Then
MsgBox\_Plus = 2
Else
MsgBox\_Plus = 3
End If
End Function
'
Private Sub Set\_Button\_Text()
Dim lngBox\_hWnd As Long
Call KillTimer(llngHwnd, TIMER\_ID)
lngBox\_hWnd = FindWindow(GC\_CLASSNAMEMSDIALOGS, lstrBoxTitel)
If lstrButtonCaption2 = "" And lstrButtonCaption3 = "" Then
Call SendDlgItemMessage(lngBox\_hWnd, vbCancel, WM\_SETTEXT, 0&, lstrButtonCaption1)
ElseIf lstrButtonCaption2 "" And lstrButtonCaption3 = "" Then
Call SendDlgItemMessage(lngBox\_hWnd, vbYes, WM\_SETTEXT, 0&, lstrButtonCaption1)
Call SendDlgItemMessage(lngBox\_hWnd, vbNo, WM\_SETTEXT, 0&, lstrButtonCaption2)
Else
Call SendDlgItemMessage(lngBox\_hWnd, vbAbort, WM\_SETTEXT, 0&, lstrButtonCaption1)
Call SendDlgItemMessage(lngBox\_hWnd, vbRetry, WM\_SETTEXT, 0&, lstrButtonCaption2)
Call SendDlgItemMessage(lngBox\_hWnd, vbIgnore, WM\_SETTEXT, 0&, lstrButtonCaption3)
End If
End Sub
Public Sub Aufruf()
Select Case MsgBox\_Plus(strText:="Ich bin der Text", strTitle:="Titel", \_
strButtonText1:="Hallo", strButtonText2:="Dirk", \_
strButtonText3:="Dubai", enmStyle:=vbInformation)
Case 1
MsgBox "Button 1"
Case 2
MsgBox "Button 2"
Case 3
MsgBox "Button 3"
End Select
End Sub