Bildschirmlupe über Uf positionieren

Hallo Leute,
die Windows10- Bildschirmlupe lässt sich mit Windows-Logo-Taste + Plus Zeichen (+) aktivieren und mit Windows-Logo-Taste + ESC deaktivieren.
https://support.microsoft.com/de-de/windows/bildschirmlupe-verwenden-damit-elemente-auf-dem-bildschirm-besser-sichtbar-sind-414948ba-8b1c-d3bd-8615-0e5e32204198
Die Beispieldatei


https://www.herber.de/bbs/user/143321.xlsb

enthält eine UF mit diversen (hier funktionslosen) CommandButtons sowie einer als Bilddatei eingefügten Weltkarte.
Über die Schaltfläche "Bildschirmlupe Ein / Aus" soll die Windows10- Bildschirmlupe über der Weltkarte positioniert und auch wieder deaktiviert werden.
Zusätzlich soll durch Bewegung der Maus (aus dem Bereich der Weltkarte heraus), die Bildschirmlupe deakiviert werden.
Hat jemand in diesem Forum einen Vorschlag um diese Idee zu verwirklichen?
mfg
reiner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _ ByVal nIndex As Long) As Long Private Declare PtrSafe Function GetDesktopWindow Lib "user32.dll" () As LongPtr Private Declare PtrSafe Function GetDC Lib "user32.dll" ( _ ByVal hwnd As LongPtr) As LongPtr Private Declare PtrSafe Function ReleaseDC Lib "user32.dll" ( _ ByVal hwnd As LongPtr, _ ByVal hdc As LongPtr) As Long Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" ( _ ByVal hdc As LongPtr, _ ByVal nIndex As Long) As Long

Hallo reiner,
Entschuldigung, ich habe deine Excelversion nicht berücksichtigt. Ersetze den gesamten Code im Userform2 durch diesen:

Option Explicit

Private Declare Function GetSystemMetrics Lib "user32.dll" ( _
    ByVal nIndex As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Private Declare Function GetDC Lib "user32.dll" ( _
    ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" ( _
    ByVal hdc As Long, _
    ByVal nIndex As Long) As Long

Private Const SM_CXSCREEN As Long = 0&
Private Const SM_CYSCREEN As Long = 1&
Private Const LOGPIXELS_X As Long = 88&
Private Const LOGPIXELS_Y As Long = 90&

Private Sub UserForm_Activate()

    Dim sngWidth As Single, sngHeight As Single

    sngWidth = Width
    sngHeight = Height

    Left = 0
    Top = 0

    Width = GetSystemMetrics(SM_CXSCREEN) * GetResolution(LOGPIXELS_X)
    Height = GetSystemMetrics(SM_CYSCREEN) * GetResolution(LOGPIXELS_Y)

End Sub

Private Function GetResolution(ByVal pvlngLogPixel As Long) As Single

    Dim lnghWndDesk As Long, lnghDCDesk As Long
    Dim lnglogPixel As Long

    lnghWndDesk = GetDesktopWindow()
    lnghDCDesk = GetDC(lnghWndDesk)

    lnglogPixel = GetDeviceCaps(lnghDCDesk, pvlngLogPixel)

    Call ReleaseDC(lnghWndDesk, lnghDCDesk)

    GetResolution = 72 / lnglogPixel

End Function

Private Sub UserForm_Click()
    Call Unload(Object:=Me)
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Bildschirmlupe über Uf positionieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bildschirmlupe über Uf positionieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread