Re: Einbinden einer Grafik
18.12.2002 15:18:29
L.Vira
''------------------------------------------------------
''Es muss 3 Blätter geben:Tabelle1,Tabelle2 und Bilder
''Im Blatt Bilder müssen in Spalte A ab Zeile 1 die Namen
''der Bilder mit komplettem Pfad stehen(ohne Leerzeilen)!
''Beispiel: C:\Eigene Dateien\Eigene Bilder\Hilfegirl.jpg
''Im Blatt Bilder ab Zelle C1 stehen die Begriffe für die
''Gültigkeitsliste(lückenlos).Der Liste einen Namen geben.
''Die Zelle mit der Gültigkeitsprüfung ist in diesem Beispiel
''Tabelle2!A1
''Die unten stehende Select Case- Anweisung muss ggf. um
''weitere Einträge erweitert werden.
''Funktioniert nicht unter Excel 97
''Die offensichtlichsten Fehler sind abgefangen aber
''garantiert nicht alle.
''------------------------------------------------------
Option Explicit
Sub Bilder_laden()
Dim Sh1 As Worksheet, Sh2 As Worksheet, ShB As Worksheet
Dim SH As Shape, BName As String, Zelltext As VariantSet Sh1 = Sheets("Tabelle1")
Set Sh2 = Sheets("Tabelle2")
Set ShB = Sheets("Bilder")
If WorksheetFunction.CountA(ShB.Columns(1)) = 0 Then
MsgBox "Es sind noch keine Namen eingetragen worden! ", 64, "weise hin..."
Exit Sub
End If
If Sh1.Shapes.Count > 0 Then
On Error Resume Next
For Each SH In Sh1.Shapes
If SH.Type = 13 Then
SH.Delete
End If
Next
End If
Zelltext = Sh2.[A1]
Select Case Zelltext
Case ShB.[c1]: BName = ShB.[A1]
Case ShB.[c2]: BName = ShB.[a2]
Case ShB.[c3]: BName = ShB.[a3]
End Select
If Not Dir(BName) = "" Then
Sh1.Pictures.Insert (BName)
Else
MsgBox "Bild wurde nicht gefunden!" & Space(15), 64, "stelle fest..."
End If
Set Sh1 = Nothing
Set Sh2 = Nothing
Set ShB = Nothing
End Sub
''------------------------------------------------------
''Das gehört in das Modul der Tabelle2
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$1" Then Call Bilder_laden
End Sub