Office: Grafik durch Scrollen bewegen?

Hallo an euch Wissenden,

ich habe folgendes Problem: ich möchte, dass eine Grafik beim Scrollen nach rechts bzw. links immer mitwandert, d.h. dass sie immer sichtbar ist.

Da ich leider in VBA ziemlich unbewandert bin hatte ich gehofft, meine Vorstellung hier in Code umwandeln lassen zu können...

Meine Idee war diese: Man lässt per VBA den Wert von ActiveWindow.ScrollColumn in irgendeine Zelle schreiben.
Dann schreibt man ein weiteres Makro, dass on change dieser Zelle dieses Makro ausführt:

Code:

ActiveSheet.Shapes("Grafik 1").Top = ActiveWindow.VisibleRange.Top 
ActiveSheet.Shapes("Grafik 1").Left = ActiveWindow.VisibleRange.Left

Leider bin ich - wie gesagt - in VBA zu wenig bewandert, um das selber hinzukriegen, daher meine Hoffnung, dass das
1. machbar ist und
2. jemand von euch weiß, wie das gehen kann

Danke und lg, Sonny

 

Hi Sonny,

das Scrollen löst kein Ereignis aus, an welches man das Verschieben der Grafik binden kann. Es gäbe jedoch die Möglichkeit, das Verschieben an das Bewegen des Cursors im Tabellenblatt zu binden. Kopiere dazu den folgenden Code ins Codemodul des Tabellenblattes:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   ActiveSheet.Shapes(1).Top = Target.Offset(1, 1).Top
   ActiveSheet.Shapes(1).Left = Target.Offset(1, 1).Left
End Sub

Bis später,
Karin

 

Hallo Sonny,

es gäbe eventuell noch eine andere Möglichkeit.
Man könnte ein Bild über eine ungebundene Userform anzeigen lassen.
Die bleibt auch beim scrollen wo sie ist.
Da Du

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   ActiveSheet.Shapes(1).Top = Target.Offset(1, 1).Top
   ActiveSheet.Shapes(1).Left = Target.Offset(1, 1).Left
End Sub 

benutzen wolltest, gehe ich davon aus, Dein Bild soll immer in der linken oberen Ecke der Tabelle stehen.
So habe ich meinen Vorschlag auch aufgebaut.

Diese Variante hat natürlich auch so ihre Macken.
Die Positionierung funktioniert nur im Vollbild-Modus richtig, und auch nur wenn Excel immer in der gleichen Zoom-Stufe benutzt wird.
Schau Dir vielleicht einfach mal meine Beispieldatei an.
Als "Auslöser" habe ich das "Worksheet_Activate" Ereignis genommen, sprich jedes mal wenn Du auf das entsprechende Blatt (bei mir Nr. 1) wechselst, wird das Bild angezeigt.
Verlässt Du das Blatt, wird die UserForm entladen.

Du müsstest also in Deiner Datei eine UserForm erstellen, mit Rechtsklick und "Eigenschaften", unter "Picture" Dein entsprechendes Bild in die UserForm laden, danach die Größe der Form nach Belieben anpassen.
Wichtig sind noch zwei Einstellungen:
ShowModal = false
PictureSizeMode = 3 - fmPictureSizeModeZoom

Danach folgenden Code in das Modul des Arbeitsblattes kopieren, wo das Bild angezeigt werden soll:

Code:

Option Explicit

Private Sub Worksheet_Activate()
    UserForm1_Image1.Show
End Sub

Private Sub Worksheet_Deactivate()
    Unload UserForm1_Image1
End Sub

Oder Du überlegst Dir einen anderen Auslöser für die Anzeige. Zum Beispiel Workbook_Open.
Natürlich musst Du den Namen der Form im Code noch anpassen.

Danach folgenden Code in das Modul der UserForm kopieren:

Code:

Option Explicit

' Rahmen der Userform entfernen
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32.dll" ( _
    ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32.dll" () As Long

Private Const GC_CLASSNAMEMSEXCELFORM = "ThunderDFrame"
Private Const GWL_STYLE = -16
Private Const WS_CAPTION = &HC00000
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1

Private hWndForm As Long


' Userform positionieren
Private Declare Function FindWindowEx Lib "user32" _
    Alias "FindWindowExA" (ByVal hWnd1 As Long, _
    ByVal hWnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
Private Declare Function GetWindowRect Lib "user32" _
    (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
        Left As Long
        Top As Long
End Type



Private Sub UserForm_Activate()

' Rahmen der Userform entfernen
    hWndForm = FindWindow(GC_CLASSNAMEMSEXCELFORM, Me.Caption)
    If hWndForm <> 0 Then
        SetWindowLong hWndForm, GWL_STYLE, GetWindowLong(hWndForm, GWL_STYLE) And Not WS_CAPTION
        DrawMenuBar hWndForm
    End If

' Userform positionieren
    Dim Fenster As RECT
    Dim hwndWindow&
    Static hwndMainWindow&, hwndDeskWindow&
    
    If hwndMainWindow = 0 Then
        ' Handle auf Excel holen
        hwndMainWindow = FindWindowEx(0&, 0&, "XLMAIN", Application.Caption)
        ' Abmessungen in Pixel
        GetWindowRect hwndMainWindow, Fenster
        ' Handle auf Clientbereich
        hwndDeskWindow = FindWindowEx(hwndMainWindow, 0&, "XLDESK", vbNullString)
        If hwndDeskWindow = 0 Then MsgBox "Falscher Klassenname XLDESK"
    End If
    
    ' Handle auf 1. Window
    hwndWindow = FindWindowEx(hwndDeskWindow, 0&, "EXCEL7", vbNullString)
    If hwndWindow = 0 Then MsgBox "Falscher Klassenname EXCEL7"
    ' Größe ermitteln
    GetWindowRect hwndWindow, Fenster

    With Fenster
        ' Wenn Zeilen- und Spaltenköpfe sichtbar sind
        If ActiveWindow.DisplayHeadings = True Then
            ' 16 Pixel nach unten
            .Top = .Top + 16
            ' 16 Pixel nach rechts
            .Left = .Left + 16
        End If
        ' Ränder berücksichtigen
        .Left = .Left + 6
        .Top = .Top - 14
    End With
    
    ' Position der UserForm
    Me.Left = Fenster.Left
    Me.Top = Fenster.Top
    
    Exit Sub
    
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    
    ' Rahmen der Userform entfernen
    If Button = 1 Then
        ReleaseCapture
        SendMessage hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    End If
    
End Sub

Eventuell musst Du hier:

Code:

    With Fenster
        ' Wenn Zeilen- und Spaltenköpfe sichtbar sind
        If ActiveWindow.DisplayHeadings = True Then
            ' 16 Pixel nach unten
            .Top = .Top + 16
            ' 16 Pixel nach rechts
            .Left = .Left + 16
        End If
        ' Ränder berücksichtigen
        .Left = .Left + 6
        .Top = .Top - 14
    End With

noch ein wenig mit den Zahlen spielen und Feintuning betreiben.
Die Werte stimmen bei mir, müssen es aber bei Dir nicht unbedingt auch tuen.


Das sollte es gewesen.

Übrigens, fast alles habe ich mir im Netz zusammen gesucht, und "API" ist nicht mein Spezialgebiet.
Wenn jemand etwas verbessern kann, dann gerne.


Ich hoffe geholfen zu haben.

 

Hi Achim,

ich glaube, ich hab das irgendwie verbockt...

Ich habe deinen Code so umgesetzt wie du es beschrieben hast, aber beim Ausführen (d.h. wenn ich das Arbeitsblatt aktiviere) meckert er bei

Code:

Private Sub Worksheet_Activate()
    UserForm1_Image1.Show
End Sub

und meint, dass eine Variable nicht definiert wäre...
Als Volllaie vermute ich mal, dass er nicht weiß, dass ich mit Image1 meine reingeladene Grafik meine, oder? Ich habe aber nirgends gefunden, wie das Ding jetzt wirklich bei ihm heißt, oder wie ich das einstellen könnte

Sagt dir das was?

lg Sonny

 

Ich vermute, Du hast den Namen der Userform nicht angepasst, so wie ich es geschrieben habe.
"UserForm1_Image1" ist der Name meiner Userform.
Entweder Du änderst den Namen Deiner Form entsprechend, oder Du must die beiden Zeilen im Code ändern.

 

OK, habs gecheckt!

Meine hieß nur UserForm, kann ja nicht funktionieren! ;-)

Danke und lg, Sonny