Bilderanzeige per Listbox

https://www.herber.de/bbs/user/80363.xlsm
Hallo zusammen,
Ich habe ein Sheet, auf dem mehrere Grafiken dargestellt sind. Jede Grafik steht für ein bestimmtes Monatsthema. Grundsätzlich sollte nur der jüngste Monat angezeigt werden, aber die alten Monate sollen bei Bedarf auch anzeigbar sein.
Ich habe es momentan so gelöst, wie in der Beispielmappe ersichtlich.
Die Listbox wird beim Aufruf des Blattes mit allen Grafiken, die im Namen ein "SHE" tragen, gefüllt. Die Grafik, die momentan als im Vordergrund formatiert ist, wird in der Listbox angezeigt.
Wenn man in der Listbox einen Eintrag auswählt, wird diese Grafik auf "sichtbar" gesetzt, in den Vordergrund gerückt und alle anderen Grafiken auf "unsichtbar" gesetzt.
Im Prinzip funzt das auch soweit.
Allerdings habe ich noch 2 Baustellen:
1. Die Einträge in der Listbox sind unsortiert. Dort sollten aber die Monate chronologisch aufgelistet sein. Ich könnte das mit meinen VBA-Kenntnissen nur sehr umständlich manuell hinbekommen. Vielleicht kennt ja jemand einen einfachen "Trick". Wahrscheinlich müsste man die Liste der Grafiken in das Blatt eintragen, sortieren und dann wieder auslesen?
2. Wenn nun ein neues Monatsthema dazukommt, wird im Prinzip einfach nur die Grafik reinkopiert. Hierbei müsste nun sichergestellt werden, dass diese dann den korrekten Namen erhält (Dialogbox?) - ohne dass derjenige, der dass macht, VBA- oder erweiterte Excel-Kenntnisse braucht. Lässt sich das realisieren und wenn ja, wie?
Wäre super, wenn sich jemand der Sache annehmen könnte.
Danke vorab.
Gruß
David

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Bild_Letztes_Umbenennen() Dim objShape As Shape, objShape2 As Shape Dim wks As Worksheet, strAuswahl As String, strMsgText As String Set wks = ActiveSheet With wks If wks.Shapes.Count > 0 Then Set objShape = wks.Shapes(.Shapes.Count) strMsgText = "Bitte Namen des zuletzte eingefügten Bildes anpassen" Eingabe: strAuswahl = VBA.InputBox(strMsgText, Title:="Bild umbenennen", Default:=objShape.Name) If strAuswahl "" Then For Each objShape2 In wks.Shapes If LCase(objShape2.Name) = LCase(strAuswahl) Then strMsgText = "Der eingegebene Name ist bereits vorhanden." & vbLf _ & "Bitte Namen des zuletzte eingefügten Bildes anpassen" GoTo Eingabe End If Next objShape.Name = strAuswahl End If Else MsgBox "Keine Bilder vorhanden" End If End With End Sub

Hallo David,
ein neu hinzugefügtes Bild (Shape) ist eigentlich immer das letzte Shape-Objekt in der Auflistung. Deshalb wundere ich mich, dass es nicht funktioniert. Evtl. wird die Index-Nummer der Shapes auch geändert, wenn du manuell die Reihenfolge änderst.
Mit dieser Zeile wird auf das letzte Objekt in der Shapeliste zugegriffen.
Set objShape = wks.Shapes(wks.Shapes.Count)
Ich hab noch ein wenig rumgesucht. Hier jetzt ein Variante, mit der ein selektiertes Bild (Shape-Object) umbenannt werden kann.
Gruß
Franz

'Erstellt unter Excel 2010
Sub ChangeName_of_SelectedShape()
'Selektiertes Shape-Object umbenennen
Dim objShape As Object, objShape2 As Shape
Dim strAuswahl As String, strMsgText As String, NameOld As String
On Error GoTo Fehler
Set objShape = Selection
NameOld = objShape.Name
strMsgText = "Bitte Namen des selektierten Bildes anpassen" & vbLf _
& "Aktueller Name: " & NameOld
Eingabe:
strAuswahl = VBA.InputBox(strMsgText, Title:="Bild umbenennen", Default:=NameOld)
If strAuswahl  "" Then
If LCase(strAuswahl)  LCase(NameOld) Then
For Each objShape2 In ActiveSheet.Shapes
If LCase(objShape2.Name) = LCase(strAuswahl) Then
strMsgText = "Der eingegebene Name ist bereits vorhanden." & vbLf _
& "Bitte Namen des selektierten Bildes anpassen" & vbLf _
& "Aktueller Name: " & NameOld
GoTo Eingabe
End If
Next
objShape.Name = strAuswahl
End If
End If
Fehler:
If Err.Number  0 Then
MsgBox "Fehler-Nr.: " & Err.Number & vbLf & Err.Description & vbLf _
& "Vor Start des Makros muss ein Bild-Objekt (Shape) selektiert werden!", _
vbInformation, _
"Makro - ChangeName_of_SelectedShape"
End If
End Sub

Sub Bild_einfuegen_umbenennen() 'Selektiertes Shape-Object umbenennen Dim objShape As Object, objShape2 As Shape Dim Zelle As Range Dim strAuswahl As String, strMsgText As String, NameOld As String On Error GoTo Fehler Set Zelle = Application.InputBox(prompt:="Bitte Einfügezelle für kopiertes Bild wählen", _ Title:="Bild kopieren", Default:=ActiveCell.Address, Type:=8) Application.Goto Reference:=Zelle, scroll:=False ActiveSheet.Paste Set objShape = Selection objShape.Top = Zelle.Top + 1 objShape.Left = Zelle.Left + 1 NameOld = objShape.Name strMsgText = "Bitte Namen des selektierten Bildes anpassen" & vbLf _ & "Aktueller Name: " & NameOld Eingabe: strAuswahl = VBA.InputBox(strMsgText, Title:="Bild umbenennen", Default:=NameOld) If strAuswahl "" Then For Each objShape2 In ActiveSheet.Shapes If LCase(objShape2.Name) = LCase(strAuswahl) Then strMsgText = "Der eingegebene Name ist bereits vorhanden." & vbLf _ & "Bitte Namen des eingefügten Bildes anpassen" & vbLf _ & "Aktueller Name: " & NameOld GoTo Eingabe End If Next objShape.Name = strAuswahl End If Fehler: If Err.Number 0 Then If Err.Number = 424 Then 'Zellselektion wurde abgebrochen Else MsgBox "Fehler-Nr.: " & Err.Number & vbLf & Err.Description & vbLf _ & "Vor Start des Makros muss ein Bild kopiert werden!", _ vbInformation, _ "Makro - ChangeName_of_SelectedShape" End If End If End Sub

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bilderanzeige per Listbox

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

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread