Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
532to536
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
532to536
532to536
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nochmals Bilder einfügen

Nochmals Bilder einfügen
16.12.2004 21:57:39
Günter
Guten Abend !
Nochmals zu meinem Thema.
Ich bekomme es nicht hin, dass bei der Auswahl das entsprechende
zugehörige Bild angezeigt wird und beim Neuauswählen das alte Bild
entfernt wird.
Kann mir jemand helfen ?
https://www.herber.de/bbs/user/14938.xls
Gruss
Günter

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nochmals Bilder einfügen
Ramses
Hallo
wo liegt das Problem ?
Du liest doch den zugehörigen Wert aus der Spalte B ebenfalls aus.
Was hindert dich daran auch den Wert aus der Spalte C auszulesen ?
Du kannst ja den Namen des jeweils eingefügten Bildes in einer Public - Variablen zwischenspeichern, und zum löschen greifst du darauf zu
Das gehört in das Modul des Tabellenblatte
Option Explicit
Public tmpImageName As String
Public workWks As Worksheet


Private Sub ComboBox1_Change()
Dim myImage As String
Dim index As Integer
Dim tmpImage As Object
'Speichern des Blattes um das Bild am Ende wieder zu löschen
Set workWks = Worksheets(ActiveSheet.Name)
If ComboBox1 = "" Then
TextBox2 = ""
Else
For index = 1 To Range("A65536").End(xlUp).Row
If LCase(Left(Cells(index, 1), Len(ComboBox1))) = LCase(ComboBox1) Then
TextBox2 = Cells(index, 2)
'hier kommt der Name des Bildes
'Das ist doch nun wirklich nicht schwer
myImage = Cells(index, 3)
Exit For
End If
Next
End If
ActiveSheet.Pictures.Insert("C:\Bilder\" & myImage).Select
'Platzierung des Bildes
Set tmpImage = Selection
With tmpImage
'Zwischenspeichern des jeweiligen Bildnamens
tmpImageName = .ShapeRange.Name
'Skalieren und positionieren des Bildes
.ShapeRange.IncrementLeft 26.25
.ShapeRange.IncrementTop 19.25
.ShapeRange.ScaleWidth 0.48, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.48, msoFalse, msoScaleFromTopLeft
End With
End Sub

und das in das Klassenmodul "Diese Arbeitsmappe"
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
workWks.Shapes(tmpImageName).Delete
End Sub

Damit wird das zuletzt eingefügte Bild beim schliessen der Datei wieder gelöscht.
Gruss Rainer
Anzeige
Kleine Korrektur...
Ramses
Hallo
Das muss in das Klassenmodul der Tabelle
'Option Explicit

Private Sub ComboBox1_Change()
Dim myImage As String
Dim index As Integer
Dim tmpImage As Object
'Speichern des Blattes um das Bild am Ende wieder zu löschen
Set workWks = Worksheets(ActiveSheet.Name)
If ComboBox1 = "" Then
TextBox2 = ""
Else
For index = 1 To Range("A65536").End(xlUp).Row
If LCase(Left(Cells(index, 1), Len(ComboBox1))) = LCase(ComboBox1) Then
TextBox2 = Cells(index, 2)
'hier kommt der Name des Bildes
'Das ist doch nun wirklich nicht schwer
myImage = Cells(index, 3)
Exit For
End If
Next
End If
'Falls noch kein Bild vorhanden ist
'oder die Variable leer ist
On Error Resume Next
workWks.Shapes(tmpImageName).Delete
On Error GoTo 0
ActiveSheet.Pictures.Insert("C:\Bilder\" & myImage).Select
'Platzierung des Bildes
Set tmpImage = Selection
With tmpImage
'Zwischenspeichern des jeweiligen Bildnamens
tmpImageName = .ShapeRange.Name
Debug.Print tmpImageName
'Skalieren und positionieren des Bildes
.ShapeRange.IncrementLeft 26.25
.ShapeRange.IncrementTop 19.25
.ShapeRange.ScaleWidth 0.48, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.48, msoFalse, msoScaleFromTopLeft
End With
End Sub

Das muss in das Klassenmodul "Diese Arbeitsmappe"
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
workWks.Shapes(tmpImageName).Delete
End Sub

Und das muss in ein EIGENES Modul
Option Explicit
Public tmpImageName As String
Public workWks As Worksheet
Dann läuft es korrekt :-)
Gruss Rainer
Anzeige
AW: Kleine Korrektur...
17.12.2004 05:41:07
Günter
Danke Rainer...
Nächstes Mal nur 1 x Threat...
Gruß
Günter

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige