AW: Der .AlternativeText wird sich wahrscheinl...
06.08.2011 08:52:25
fcs
Hallo Sergej,
irgendwie ist die Logik in deinem Makro nicht ganz korrekt.
Wenn Shape "AutoShape 2" das Makro "Bilder" startet, dann ergibt sich nie Ergebnis "True" für die Zeile
If objShp.Name = "AutoShape 1" Then
und es passiert nichts, außer das der Explorer für Laufwerk "D" angezeigt wird.
Nachfolgend eine Fassung mit ein Paar mehr Prüfungen und Anzeigen, um dem Fehler auf die Spur zu kommen. Eigentlich müsste mein Vorschlag "Bilder_kurz" auch funktionieren.
VG
Franz
Sub Bilder() 'Wird von Autoshape 2 gestartet - Autoshape 2 = Caller
Dim objShp As Shape, sName As String
On Error GoTo ErrExit
Set objShp = ActiveSheet.Shapes(Application.Caller)
sName = objShp.Name
' Prüfung, ob "Autoshape 2" das Makro aufgerufen hat
If sName = "AutoShape 2" Then
Application.ScreenUpdating = False ' "Bildschirmflackern" vermeiden
Set objShp = ActiveSheet.Shapes("AutoShape 1")
With objShp.TextFrame.Characters
MsgBox "Text ""AutoShape 1"":" & .Text 'Testzeile
Select Case .Text
Case "Alle-Tabellen darstellen"
Call Bilder_AT
Case "Heim-Tabelle darstellen"
Call Bilder_GT
Case "Auswärts-Tabelle darstellen"
Call Bilder_HT
Case Else
Call Bilder_Alle
End Select
End With
Else
MsgBox "Makro ""Bilder"" wurde von Shape """ & sName & """ gestartet", _
vbInformation, "Information"
End If
ErrExit:
With Err
Select Case .Number
Case 0 'alles ist ok
Case -2147352571 'Makro wurde nicht von einem Shape gestartet
MsgBox "Makro wurde nicht von einem Shape gestartet", vbInformation, _
"Fehlerbehandlung - Makro ""Bilder"""
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbInformation, _
"Fehlerbehandlung - Makro ""Bilder"""
End Select
End With
Application.ScreenUpdating = True
Set objShp = Nothing
Shell Environ("WinDir") & "\explorer.exe /n,/e," & "D:\", vbNormalFocus
End Sub
Sub Bilder_kurz()
Dim objShp As Shape
On Error GoTo ErrExit
Application.ScreenUpdating = False ' "Bildschirmflackern" vermeiden
Set objShp = ActiveSheet.Shapes("AutoShape 1")
With objShp.TextFrame.Characters
Select Case .Text
Case "Alle-Tabellen darstellen"
Call Bilder_AT
Case "Heim-Tabelle darstellen"
Call Bilder_GT
Case "Auswärts-Tabelle darstellen"
Call Bilder_HT
Case Else
Call Bilder_Alle
End Select
End With
ErrExit:
Application.ScreenUpdating = True
Set objShp = Nothing
Shell Environ("WinDir") & "\explorer.exe /n,/e," & "D:\", vbNormalFocus
End Sub