Excel Useform: gewusst Wie: ausblenden der Anwendung, sondern haben-Symbol in der Taskleiste

Was ich haben will, ist Application.Sichtbar = False, so dass meine Benutzer nicht sehen können, die excel-Arbeitsblätter, nur das userform.

Ich habe dies funktioniert mit diesem code:

Private Sub Workbook_Open()
Application.Visible = False
UserForm2.Show
End Sub

Allerdings hat das nur die userform schwebend im hintergrund herum. Meine Benutzer haben andere Anwendungen geöffnet sind, und ich möchte, dass Sie ganz einfach ändern, um die userform, indem er ein Symbol auf der Taskleiste.

Fand ich, dass das folgende Beispiel online, aber ich kann nicht scheinen, um herauszufinden, wo dieser code. Noch ganz neu hier, also hoffentlich habe ich den richtigen code für den job. Wenn ich das Tue, kann jemand reden, der mir durch, wo es zu platzieren, wie es funktioniert nicht wenn ich es einfügen in meinen code?

(also sollte es gehen, unter "userform" oder "diese Arbeitsmappe: Erklärungen' etc. )

Danke,

Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_POPUP As Long = &H80000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_EX_DLGMODALFRAME As Long = &H1
Private Const WS_EX_APPWINDOW As Long = &H40000
Private Const SW_SHOW As Long = 5

Private Sub UserForm_Activate()
Application.Visible = False
Application.VBE.MainWindow.Visible = False
    Dim lngHwnd As Long
    Dim lngCurrentStyle As Long, lngNewStyle As Long
    If Val(Application.Version) < 9 Then
        lngHwnd = FindWindow("ThunderXFrame", Me.Caption)  'XL97
    Else
        lngHwnd = FindWindow("ThunderDFrame", Me.Caption)  'XL2000, XP, 2003?
    End If
    'Set the Windows style so that the userform has a minimise and maximise button
    lngCurrentStyle = GetWindowLong(lngHwnd, GWL_STYLE)
    lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
    lngNewStyle = lngNewStyle And Not WS_VISIBLE And Not WS_POPUP
    SetWindowLong lngHwnd, GWL_STYLE, lngNewStyle

    'Set the extended style to provide a taskbar icon
    lngCurrentStyle = GetWindowLong(lngHwnd, GWL_EXSTYLE)
    lngNewStyle = lngCurrentStyle Or WS_EX_APPWINDOW
    SetWindowLong lngHwnd, GWL_EXSTYLE, lngNewStyle
    ShowWindow lngHwnd, SW_SHOW
End Sub
Private Sub UserForm_Terminate()
Application.Visible = True
End Sub

InformationsquelleAutor Ali Lumsden | 2014-07-14

Versuchen Sie, diesen code in den UserForm-code-Modul:

Option Explicit

'API functions
Private Declare Function GetWindowLong Lib "user32" _
                                       Alias "GetWindowLongA" _
                                      (ByVal hwnd As Long, _
                                        ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
                                       Alias "SetWindowLongA" _
                                       (ByVal hwnd As Long, _
                                        ByVal nIndex As Long, _
                                        ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
                                      (ByVal hwnd As Long, _
                                       ByVal hWndInsertAfter As Long, _
                                       ByVal X As Long, _
                                       ByVal Y As Long, _
                                       ByVal cx As Long, _
                                       ByVal cy As Long, _
                                       ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" _
                                    Alias "FindWindowA" _
                                    (ByVal lpClassName As String, _
                                     ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" _
                                         () As Long
Private Declare Function SendMessage Lib "user32" _
                                     Alias "SendMessageA" _
                                     (ByVal hwnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long
Private Declare Function DrawMenuBar Lib "user32" _
                                     (ByVal hwnd As Long) As Long



'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Private Sub AppTasklist(myForm)

'Add this userform into the Task bar
    Dim WStyle As Long
    Dim Result As Long
    Dim hwnd As Long
    hwnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLong(hwnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)

End Sub

Private Sub UserForm_Activate()

Application.Visible = False
Application.VBE.MainWindow.Visible = False
AppTaskList Me

End Sub

Private Sub UserForm_Terminate()

Application.Visible = True

End Sub

Disclaimer: Dies ist nicht mein code, und wurde auf einem forum, welches ich nicht habe den link nicht mehr.

Vielen Dank für Ihre Lösung. Ich bekomme folgende Kompilierungsfehler: 'Nur die Kommentare erscheinen nach End Sub, End Function oder End Property'. Ich hatte nicht diese Fehler, bevor ich Ihren code eingefügt. Ich habe auch entfernt alle Kommentare aus Ihrem code, aber immer noch nichts, irgendwelche Ideen?
Ich habe es gerade getestet und es funktionierte für mich. Stellen Sie sicher, stellen Sie diese oben in das Modul und nicht die doppelte Option Explicit - Anweisung.
Ich habe meinen code in ein Chaos rund um das Spiel versucht, diese zu arbeiten. Werde ich versuchen und gehen Sie zurück durch, um sicherzustellen, dass ich habe nicht alles, was verwirrend (also danke für die Tests). Kann dir nur bestätigen, bei mir, was bedeutet "useform-code-Modul'. Soll ich diese unter den tabs UserForm und Aktivieren? Oder sollte ich ein neues Modul erstellen? Sorry für newbness.
Rechten Maustaste auf das userform im Projekt-Explorer-Fenster, und wählen Sie Code Anzeigen, dann fügen Sie diesen code in.
Danke-ich merkte, ich war die einige dumme Zimmerreinigung Fehler. Das ist, warum es nicht funktionieren würde. Danke Euch beiden, top-Marken.

InformationsquelleAutor Gareth

So, wie Sie vielleicht bemerkt, diese funktionieren nicht auf der 64 bit-version von excel.

Machte ich es kompatibel durch das hinzufügen von Bedingungen zu dem code, den ich nahm aus hier.

Falls Sie sich Fragen, wie Sie API-Funktionen, kompatibel mit 64 bit Versionen von Excel hier es einen ausgezeichneten Artikel, die Sie erhalten, Sie durch.

Option Explicit

'API functions
#If VBA7 Then

    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long _
            ) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long _
            ) As LongPtr
    #End If

    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long, _
             ByVal dwNewLong As LongPtr _
            ) As LongPtr
    #Else
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long, _
             ByVal dwNewLong As LongPtr _
            ) As LongPtr
    #End If

    Private Declare PtrSafe Function SetWindowPos Lib "user32" _
        (ByVal hWnd As LongPtr, _
         ByVal hWndInsertAfter As LongPtr, _
         ByVal X As Long, ByVal Y As Long, _
         ByVal cx As Long, ByVal cy As Long, _
         ByVal wFlags As Long _
        ) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
         ByVal lpWindowName As String _
        ) As LongPtr
    Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As LongPtr, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any _
        ) As LongPtr
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As LongPtr) As LongPtr

#Else

    Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As Long, _
         ByVal nIndex As Long _
        ) As Long
    Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, _
         ByVal nIndex As Long, _
         ByVal dwNewLong As Long _
        ) As Long
    Private Declare Function SetWindowPos Lib "user32" _
        (ByVal hWnd As Long, _
         ByVal hWndInsertAfter As Long, _
         ByVal X As Long, ByVal Y As Long, _
         ByVal cx As Long, ByVal cy As Long, _
         ByVal wFlags As Long _
        ) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
         ByVal lpWindowName As String _
        ) As Long
    Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any _
        ) As Long
    Private Declare Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As Long) As Long

#End If


'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Und verwenden Sie dann die folgenden Unterprogramme:

Private Sub UserForm_Activate()
    AddIcon    'Add an icon on the titlebar
    AddMinimizeButton   'Add a Minimize button to Userform
    AppTasklist Me    'Add this userform into the Task bar
End Sub

Private Sub AddIcon()
'Add an icon on the titlebar
    Dim hWnd As Long
    Dim lngRet As Long
    Dim hIcon As Long
    hIcon = Sheet1.Image1.Picture.Handle
    hWnd = FindWindow(vbNullString, Me.Caption)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
    lngRet = DrawMenuBar(hWnd)
End Sub

Private Sub AddMinimizeButton()
'Add a Minimize button to Userform
    Dim hWnd As Long
    hWnd = GetActiveWindow
    Call SetWindowLongPtr(hWnd, GWL_STYLE, _
                       GetWindowLongPtr(hWnd, GWL_STYLE) Or _
                       WS_MINIMIZEBOX)
    Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
                      SWP_FRAMECHANGED Or _
                      SWP_NOMOVE Or _
                      SWP_NOSIZE)
End Sub

Private Sub AppTasklist(myForm)
'Add this userform into the Task bar
    #If VBA7 Then
        Dim WStyle As LongPtr
        Dim Result As LongPtr
        Dim hWnd As LongPtr
    #Else
        Dim WStyle As Long
        Dim Result As Long
        Dim hWnd As Long
    #End If

    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLongPtr(hWnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLongPtr(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)
End Sub

Ich noch nicht getestet, aber auf 32-bit-Versionen von excel, aber es sollte ohne Probleme funktionieren.

Dies wirft ein "type mismatch" auf 64-bit-Versionen, wo FindWindow gibt eine LongPtr aber in AddIcon die hWnd erklärt wird Long statt LongPtr

InformationsquelleAutor César Mades

Schreibe einen Kommentar

Du musst angemeldet sein, um einen Kommentar abzugeben.