Beim öffnen einer Exceldatei möchte ich

… gefragt werden ob ich Bild 1 und Text 1 oder Bild 2 und Text 2 haben möchte. Die Bilder und Texte sind auf mehreren Arbeitsblätter auch mehrmals vorhanden.

Hallo André,

in Excel kann man Tabellenblätter oder Diagrammblätter aktivieren. Alle anderen Objekte sind nicht direkt zugänglich, da sie Unterobjekte der Blätter sind.

Ich hab mich mal auf Tabellenblätter beschränkt.
Innerhalb der Tabellenblätter kann man dann nach Inhalten suchen.
A: Bilder als Shape mit dem Namen des Bildes
B: Text in einer Zelle.

Gruß
Franz

'Einfügen im VBA-Projekt der Datei unter "DieseArbeitsmappe"
Private Sub Workbook\_Open()
 Dim wks As Worksheet, boolBild As Boolean, boolText As Boolean
 Dim arrBT(1 To 3, 1 To 2) As String 'Zeilen im Array an Anzahl der Bilder anpassen
 Dim iIndex As Integer, oShape As Shape
 Dim sMsgText As String
 'Namen von Bildern und Text in Zellen, die gesucht werden sollen
 arrBT(1, 1) = "Bild 1": arrBT(1, 2) = "Text 1"
 arrBT(2, 1) = "Bild 22": arrBT(2, 2) = "Text 2"
 arrBT(3, 1) = "Bild 3": arrBT(3, 2) = "Text 3"
 'Prompt-Text der Inputbox zusammenstellen
 For iIndex = LBound(arrBT, 1) To UBound(arrBT, 1)
 sMsgText = sMsgText & iIndex & " = " & arrBT(iIndex, 1) & " - " & arrBT(iIndex, 2) & vbLf
 Next
 sMsgText = sMsgText & vbLf & "Bitte gewünschte Nr eingeben"
Eingabe:
 iIndex = Val(Application.InputBox(sMsgText, "Auswahl Bild-Text", 1))
 Select Case iIndex
 Case 0
 'Abbrechen
 Case LBound(arrBT, 1) To UBound(arrBT, 1)
 For Each wks In Me.Worksheets
 boolBild = False: boolText = False
 'Überprüfen der Namen der Shape-Objekte
 For Each oShape In wks.Shapes
 If UCase(oShape.Name) = UCase(arrBT(iIndex, 1)) Then
 boolBild = True
 Exit For
 End If
 Next
 If boolBild = True Then
 'Zelle mit dem Text suchen
 If Not wks.UsedRange.Find(what:=arrBT(iIndex, 2), lookat:=xlWhole, \_
 LookIn:=xlValues) Is Nothing Then
 boolText = True
 Exit For
 End If
 End If
 Next

 If boolBild = True And boolText = True Then
 'Tabellenblatt aktivieren und Scrollen
 wks.Activate
 oShape.TopLeftCell.Select
 ActiveWindow.ScrollRow = oShape.TopLeftCell.Row
 End If
 Case Else
 MsgBox "Üngültige Eingabe", vbInformation, "Auswahl Bild-Text"
 GoTo Eingabe
 End Select
End Sub