Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
836to840
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
836to840
836to840
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Bild laden nach Zellauswahl

Bild laden nach Zellauswahl
22.01.2007 16:45:13
Gerhard
Hallo zusammen,
wie kann ich in einer Excel- Datenbank nach Auswahl der Zelle D5 das Bild 1
(.jpg)laden und anzeigen, nach verlassen dieser Zelle soll das Bild 1 wieder automatisch ausgeblendet werden.
Nach Auswahl der Zelle D6 soll Bild 2 geladen und angezeigt werden nach verlassen der Zelle D6 soll Bild 2 wieder ausgeblendet werden...
Die Bilder stehen im Verzeichnis D\Daten\Bilder\Bild 1.jpg ....
Vielen Dank für Eure Hilfe
Gruß Gerhard

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bild laden nach Zellauswahl
22.01.2007 18:56:04
Josef
Hallo Gerhard,
handelt es sich nur um die zwei Bilder?
Worin oder wohin (Zelle oder Imagesteuerelement) sollen die Bilder geladen werden?
Gruß Sepp

AW: Bild laden nach Zellauswahl
22.01.2007 20:05:16
Gerhard
Hallo,
1. es sind bisher ca. 150 Bilder (werden aber erweitert..)
2. Ich will in der Datenbanktabelle, wenn ich die entsprechende Zelle anspringe
das dazugehörige Bild mir anzeigen lassen, und das Bild sollte wieder ausgeblendet werden, wenn ich die Zelle verlasse.
Wie das Bild angezeigt wird ist egal, es sollte nur nicht die Datenbanktabelle verlassen werden. Ich stelle mir vor das angezeigte Bild eine Größe von 5cmx5cm haben sollte.
Ich hoffe, Deine Fragen beantwortet zu haben.
Gruß
Gerhard
Anzeige
AW: Bild laden nach Zellauswahl
22.01.2007 20:15:19
Josef
Hallo Gerhard,
eine Frage noch, stehen die Bildnamen in den einzelnen Zellen, oder sind die Bilder
einfach durchnummeriert?
Gruß Sepp

AW: Bild laden nach Zellauswahl
22.01.2007 20:34:36
Gerhard
hallo,
ich habe in dem Bilderverzeichnis die Bilder durchnummeriert von Bild 1, Bild 2, Bild 3 usw.
es muss, entsprechend der ausgewählten Zelle jeweils eine Zuordnung erfolgen wie:
sprung in Zelle D5 soll Bild 1 erscheinen,
sprung in Zelle D6 soll Bild 2 erscheinen,
sprung in Zelle D7 soll Bild 3 erscheinen usw.
Gruß
Gerhard
AW: Bild laden nach Zellauswahl
22.01.2007 20:51:46
Josef
Hallo Gerhard,
kopiere den folgenden Code in das Modul der entsprechenden Tabelle.
(Rechtsklick auf Blattregister > Code Anzeigen > in das rechte Fenster einfügen)
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Const strPath As String = "D:\Daten\Bilder\"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range
    Dim strFile As String
    Dim objPic As Object
    
    On Error Resume Next
    Me.Shapes("temp").Delete
    On Error GoTo ErrExit
    
    Set rng = Target(1, 1)
    
    If rng.Column = 4 And rng.Row > 4 Then
        strFile = strPath & "Bild " & rng.Row - 4 & ".jpg"
        If Dir(strFile) <> "" Then
            Application.ScreenUpdating = False
            Set objPic = Me.Pictures.Insert(strFile)
            With objPic.ShapeRange
                .Name = "temp"
                .Left = rng.Left + rng.Width
                .Top = rng.Top
                .LockAspectRatio = True
                .Width = 150
            End With
        End If
    End If
    
    ErrExit:
    Application.ScreenUpdating = True
    Set objPic = Nothing
    Set rng = Nothing
End Sub

Gruß Sepp
Anzeige
AW: Bild laden nach Zellauswahl
22.01.2007 21:22:08
Hubert
Dirty
On Error Resume Next
Me.Shapes("temp").Delete
On Error GoTo ErrExit
Das kannst du besser, Sepp.
mfg Hubert
Dirty, abber...
22.01.2007 21:26:06
Josef
Hallo Hubert,
...für diesen Fall, so glaube ich jedenfalls, durchaus vertretbar.
Nur um ein einzelnes Shape zu löschen, lohnt sich doch der Aufwand nicht.
Gruß Sepp

AW: Dirty, abber...
22.01.2007 21:33:36
Gerhard
hallo,
funktioniert prima!
habe noch ein Frage,
was muss ich machen, wenn die Namen der Bilddateien nicht Bild 1, Bild 2 usw. heissen sondern gleich die richtigen Namen hätten wie:
ZelleD5: BKl1
ZelleD6: TEL1
ZelleD7: RKL2
ZelleD8: FKL6
usw. ?
Gruß
Gerhard
Anzeige
AW: Dirty, abber...
22.01.2007 21:39:12
Josef
Hallo Gerhard,
wenn die Zellen den Dateinamen der Bilder ohne Extension (.JPG) beinhalten, dann ändere die Zeile
strFile = strPath & "Bild " & rng.Row - 4 & ".jpg"

um in
strFile = strPath & rng.Text & ".jpg"

Gruß Sepp
Bild nach Zellauswahl
23.01.2007 18:26:26
Gerhard
Hallo,
nachdem das Programm soweit super funktioniert möchte ich zusätzlich
ab der Spalte E4 die Bilder mit verschiedenen Zeichnunsnr. anzeigen lassen wie:
Die Bilder sind hinterlegt im Verzeichnis: D:\Daten\Zeichnungen
Die Bilder sind abgespeichert unter:
BKKL.jpg, TEKL.jpg, RKKL.jpg, KKKL.jpg und LKKL.jpg
Diese Bilder sollen ebenfalls nachdem die Zelle E4 angewählt soll Bild BBKL.jpg
angezeigt werden. Bei Auswahl E10 soll Bild TEKL.jpg angezeigt werden.
Bei E14 soll Bild RKKL.jpg, bei E20 soll KKKL.jpg und bei E27 soll LKKL.jpg
angezeigt werden.
Vielen Dank für Eure Hilfe
Gruß Gerhard
Anzeige
AW: Bild nach Zellauswahl
23.01.2007 20:49:14
Josef
Hallo Gerhard,
das sollte es tun.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Const strPath As String = "D:\Daten\"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range
    Dim strFile As String
    Dim objPic As Object
    
    On Error Resume Next
    Me.Shapes("temp").Delete
    On Error GoTo ErrExit
    
    Set rng = Target(1, 1)
    
    If rng.Column = 4 And rng.Row > 4 Then
        strFile = strPath & "Bilder\" & rng.Text & ".jpg"
    ElseIf Not Intersect(rng, Range("E4", "E10", "E14", "E20", "E27")) Is Nothing Then
        Select Case rng.Address(0, 0)
            Case "E4"
                strFile = strPath & "Zeichnungen\BBKL.jpg"
            Case "E10"
                strFile = strPath & "Zeichnungen\TEKL.jpg"
            Case "E14"
                strFile = strPath & "Zeichnungen\RKKL.jpg"
            Case "E20"
                strFile = strPath & "Zeichnungen\KKKL.jpg"
            Case "E27"
                strFile = strPath & "Zeichnungen\LKKL.jpg"
            Case Else
        End Select
    End If
    
    If Dir(strFile) <> "" Then
        Application.ScreenUpdating = False
        Set objPic = Me.Pictures.Insert(strFile)
        With objPic.ShapeRange
            .Name = "temp"
            .Left = rng.Left + rng.Width
            .Top = rng.Top
            .LockAspectRatio = True
            .Width = 150
        End With
    End If
    
    ErrExit:
    Application.ScreenUpdating = True
    Set objPic = Nothing
    Set rng = Nothing
End Sub

Gruß Sepp
Anzeige
Korrektur!
23.01.2007 21:00:01
Josef
Hallo nochmal,
da sind mir doch ein paar (") zuviel reingerutscht ;-))
So muss es lauten.
ElseIf Not Intersect(rng, Range("E4, E10, E14, E20, E27")) Is Nothing Then

Gruß Sepp
eine etwas aufwendige...
22.01.2007 20:16:29
jockel
hi Gerhard,... aber funktionierende variante ist einen kommentar einfügen und dann formatieren; register farben und linien; farbe; füllefekte; register grafik;grafik auswählen (und evtl. noch höhe und breite anpassen) fertig!
cu jörg
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige