Bie Mouseover Datei anzeigen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Harald,
ändere den Code im Modul so:

Option Explicit

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 Declare Function GetCursorPos Lib "user32.dll" ( _
    ByRef lpPoint As POINTAPI) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Public Sub Start()
    Call SetTimer(Application.hwnd, 0, 500, AddressOf StartTimer)
End Sub

Private Function StartTimer(ByVal hwnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

    Static ssstrAddress As String

    Dim udtPoint As POINTAPI
    Dim objUnknown As Object

    If GetForegroundWindow = Application.hwnd Then

        On Error GoTo err_exit

        Call GetCursorPos(udtPoint)

        Set objUnknown = ActiveWindow.RangeFromPoint(udtPoint.x, udtPoint.y)

        If TypeOf objUnknown Is Range Then

            If objUnknown.Hyperlinks.Count = 1 Then

                If Right$(objUnknown.Hyperlinks(1).Address, 4) = ".jpg" Then

                    If ssstrAddress <> objUnknown.Address Then

                        ssstrAddress = objUnknown.Address

                        Call Unload(Object:=UserForm1)

                        With UserForm1

                            Set .Picture = LoadPicture(Filename:=ThisWorkbook.Path & _
                                "\" & objUnknown.Hyperlinks(1).Address)

                            Call .Show

                        End With

                    End If
                Else
                    ssstrAddress = vbNullString
                    Call Unload(Object:=UserForm1)
                End If
            Else
                ssstrAddress = vbNullString
                Call Unload(Object:=UserForm1)
            End If
        Else
            ssstrAddress = vbNullString
            Call Unload(Object:=UserForm1)
        End If
    End If

    err_exit:

End Function

Public Sub StopTimer()
    Call KillTimer(Application.hwnd, 0)
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bie Mouseover Datei anzeigen

6 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)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread