Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1744to1748
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
Inhaltsverzeichnis

VBA: Ansprechen von eingefügten Bildern

VBA: Ansprechen von eingefügten Bildern
04.03.2020 21:32:41
eingefügten
Hallo VBA Freunde,
Folgende Ausgangssituation:
Ich habe einen Reiter in der Excel-Mappe in dem ein Protokoll geführt wird --> Spalten A-H
In der "Spalte I" ist eine leere Zelle, in die ein Bild zu dem jeweiligen Protokolleintrag _ eingefügt werden soll (im unteren Makro ist es Spalte I = ActiveCell). Dieses Bild soll der Nutzer selbst von seinem PC auswählen - über ein ActiveX-Button und das Standard-Dialogfenster. Um die eingefügten Bilder dann entsprechend zu richten und die Größe anzupassen, habe ich ein Makro geschrieben:

Sub BilderEinfuegen()
Dim objFile As Object
Dim ObjektDLG As Dialog
Dim T As Double, L As Double
T = ActiveCell.Top
L = ActiveCell.Left
Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture)
ObjektDLG.Show
Application.ScreenUpdating = True
For Each objFile In ActiveSheet.Shapes
objFile.Width = 150
objFile.Top = T
objFile.Left = L
T = T + objFile.Width
Next
Application.ScreenUpdating = False
End Sub

Folgende Problematik:
Das Problem bei dem Makro ist, dass er damit ALLE Shapes anspricht (und damit auch z.B. den ActiveX-Button) und die nacheinander ausrichtet.
Ich möchte jedoch, dass er NUR die neu eingefügten Bilder ausrichtet (es kann sowohl 1 als auch 5 Bilder sein, die der User über das Dialogfenster zum Einfügen auswählt)
Folgende Fragestellung:
Wie spreche ich diese neu eingefügten Bilder an, ohne die bereits vorhanden Bilder/Shapes in dem Reiter anzufassen?
Wäre euch sehr dankbar für Lösungsvorschläge
Viele Grüße
Anton

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

Betreff
Datum
Anwender
Anzeige
AW: VBA: Ansprechen von eingefügten Bildern
04.03.2020 22:04:51
eingefügten
Hallo Anton,
folgende Idee.
Ermittle und merke Dir die bereits vorhandenen Bilder und filter sie anschließend aus:
Sub BilderEinfuegen()
 
 Dim objFile As Object
 Dim ObjektDLG As Dialog
 Dim T As Double, L As Double
 Dim sAlteBilder As String
 T = ActiveCell.Top
 L = ActiveCell.Left
 
'Schon vorhandene Bilder ermitteln
 For Each objFile In ActiveSheet.Shapes
   sAlteBilder = sAlteBilder & objFile.Name & ","
 Next
 
 Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture)
 ObjektDLG.Show
 Application.ScreenUpdating = False
 
'Neue Bilder positionieren
 For Each objFile In ActiveSheet.Shapes
   If InStr(sAlteBilder, objFile.Name & ",") = 0 Then
     objFile.Width = 150
     objFile.Top = T
     objFile.Left = L
     T = T + objFile.Width
   End If
 Next
 Application.ScreenUpdating = True
 
End Sub
viele Grüße
Karl-Heinz

Anzeige
AW: VBA: Ansprechen von eingefügten Bildern
05.03.2020 10:05:10
eingefügten
Hallo Karl-Heinz,
Danke für die schnelle Rückmeldung - ist schon mal eine super Lösung, funktioniert mit mehreren Bildern auf einmal.
Die verbleibende Frage wäre für mich: könnte man es auch so programmieren, dass das Makro versteht, wenn ich ein Bild hinzugefügt habe und dann 5 min später noch ein Bild in die gleiche Zelle hinzufügen würde.
Aktuell mit dem Makro würde er ja einfach das neue Bild über dem alten platzieren.
Eine Idee?
Danke schon mal im Voraus
Viele Grüße
Anton
AW: VBA: Ansprechen von eingefügten Bildern
05.03.2020 11:28:35
eingefügten
Hallo Anton,
hier noch eine Erweiterung als Idee:
Sub BilderEinfuegen()
 Dim objShape As Object
 Dim ObjektDlg As Dialog
 Dim T As Double, L As Double, H As Double
 Dim sAlteBilder As String
 T = ActiveCell.Top
 L = ActiveCell.Left
 
'Schon vorhandene Bilder ermitteln und merken
 For Each objShape In ActiveSheet.Shapes
   With objShape
     H = .Height
     With .TopLeftCell
       If .Column = ActiveCell.Column Then
          If .Top + H > T Then T = .Top + H
       End If
     End With
     sAlteBilder = sAlteBilder & .Name & ","
   End With
 Next
 Set ObjektDlg = Application.Dialogs(xlDialogInsertPicture)
 ObjektDlg.Show
 Application.ScreenUpdating = False
 
'Neue Bilder positionieren
 For Each objShape In ActiveSheet.Shapes
   If InStr(sAlteBilder, objShape.Name & ",") = 0 Then
     objShape.Width = 150
     objShape.Top = T
     objShape.Left = L
     T = T + objShape.Width
   End If
 Next
 Application.ScreenUpdating = True
 
End Sub
viele Grüße
Karl-Heinz

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige