Bilder ersetzen mit auswahlmöglichkei

[Frihai]

Hallo!

Vielleicht kann mir ja jemand helfen - denke mal für die Profis unter euch ist das kein Problem!!!

Ich müsste in einer excel Tabelle immer wieder Bilder ersetzen und das am besten auf Knopfdruck... bis jetzt habe ich viel im Netz gestöbert jedoch keine Lösung dazu gefunden die passen würde. 

Also ich Versuch es mal:
Ich habe ein Bild in excel eingefügt - das passt logischerweise...
Natürlich kann ich mittels "Bild ersetzen" das Bild manuell austauschen.

Die Anforderung wäre genau die das mir excel mittels Makro die Möglichkeit gibt diesen Schritt zu automatisieren und mir einfach sobald ich das Makro Aufrufe mir den Datei-Explorer öffnet wo ich dann das Bild wählen kann welches eingefügt werden soll.Ich bedanke mich bereits im Vorhinein sollte jemand von euch das lösen können!!!DANKE

Frihai

[schauan]

Hallöchen,

das könnte man so lösen. Das zu tauschende Bild sollte vorher selektiert werden - was sonst geschehen kann - siehe Kommentar im Code, Die Liste der Dateitypen kannst Du kürzen oder auf andere Grafikformate erweitern / ändern.

Code:

Sub BilderTausch()
'Variablendeklaration - String
Dim strMyPicture$
'Auswahl Loeschen - sollte das alte Biild sein
'Hinweis: Hier koennte noch eine Pruefung rein, ob ein Bild gewaehlt ist.
'Ansonsten koennte versehentlich ein Zellinhalt geloescht werden.
Selection.Delete
'Wechsel auf das BildLaufwerk
ChDrive "G:"
'Wechsel auf das Bildverzeichnis
ChDir "G:\Test"
'Dialog zum Auswählen eines Bildes aufrufen und Name merken
strMyPicture = Application.GetOpenFilename("Bilder (*.bmp; *.jpg; *.png), *.bmp; *.jpg; *.png")
'Bild einfuegen
ActiveSheet.Pictures.Insert(strMyPicture).Select
End Sub

[Kuwer]

Hallo,

ich habe André`s Entwurf mal erweitert.
 - der Typ der Selektion wird geprüft
 - das alte Bild wird nur gelöscht, wenn
    - wirklich ein neues gewählt wurde
    - die sonstige Löschanfrage mit Ja bestätigt wird
- das neue Bild wird an der Position des alten eingefügt.

Sub BilderTauschMitPruefung()
   Dim strMyPicture As String
   Dim dblPos(1 To 4) As Double
   'Pruefung, ob ein Bild gewaehlt ist.
   'Ansonsten koennte versehentlich ein Zellinhalt geloescht werden.
   If TypeName(Selection) = "Picture" Then
     dblPos(1) = Selection.Left
     dblPos(2) = Selection.Top
     dblPos(3) = Selection.Width
     dblPos(4) = Selection.Height
     'Wechsel auf das BildLaufwerk
     'ChDrive "G:"
     'Wechsel auf das Bildverzeichnis
     'ChDir "G:\Test"
     'Dialog zum Auswählen eines Bildes aufrufen und Name merken
     strMyPicture = Application.GetOpenFilename("Bilder (*.bmp; *.jpg; *.png), *.bmp; *.jpg; *.png")
     'nur wenn wirklich ein Bild gewaehlt wurde
     If CVar(strMyPicture) <> False Then
       'Auswahl Loeschen - sollte das alte Biild sein
       Selection.Delete
       'Bild einfuegen
       ActiveSheet.Pictures.Insert(strMyPicture).Select
       Selection.Left = dblPos(1)
       Selection.Top = dblPos(2)
       'Selection.Width = dblPos(3)  'wenn gewünscht
       'Selection.Height = dblPos(4) 'wenn gewünscht
     Else
       If MsgBox("Es wurde kein Ersatzbild gewählt." & vbNewLine & _
                 "Soll das alte Bild gelöscht werden?", _
                 vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
         Selection.Delete
       End If
     End If
   Else
     MsgBox "Es wurde kein zu ersetzendes Bild ausgewählt!", vbInformation + vbOKOnly
   End If
End Sub

Gruß Uwe

[steve1da]

Hola,

zur Info...

http://www.ms-office-forum.net/forum/sho...p?t=350232

Gruß,
steve1da

[Frihai]

Hallo Uwe!

Deine Lösung arbeitet bereits sehr gut! 

Jetzt habe ich nur noch folgendes Problem:

Da sich im Bildbereich noch ein gelber Preisbalken mit dem jeweiligen Preis des Produktes befindet ist es im Moment noch so das sobald ich das Bild mittels Makro austausche dieser im Hintergrund verschwindet. Wenn wir das noch hinbekommen dass das mittels Makro ausgetauschte Bild in den Hintergrund wandert und somit der Preisbalken vorne drüber liegt dann habe ich genau die Lösung so wie ich sie gerne hätte.

Vielleicht schaffen wir das noch - ich wäre überglücklich mit der Lösung!

DANKE!!! DANKE!!!!

[Kuwer]

Hallo,

dann mit einer zusätzlichen Zeile (rote Schrift):

Sub BilderTauschMitPruefung()
   Dim strMyPicture As String
   Dim dblPos(1 To 4) As Double
   'Pruefung, ob ein Bild gewaehlt ist.
   'Ansonsten koennte versehentlich ein Zellinhalt geloescht werden.
   If TypeName(Selection) = "Picture" Then
     dblPos(1) = Selection.Left
     dblPos(2) = Selection.Top
     dblPos(3) = Selection.Width
     dblPos(4) = Selection.Height
     'Wechsel auf das BildLaufwerk
     'ChDrive "G:"
     'Wechsel auf das Bildverzeichnis
     'ChDir "G:\Test"
     'Dialog zum Auswählen eines Bildes aufrufen und Name merken
     strMyPicture = Application.GetOpenFilename("Bilder (*.bmp; *.jpg; *.png), *.bmp; *.jpg; *.png")
     'nur wenn wirklich ein Bild gewaehlt wurde
     If CVar(strMyPicture) <> False Then
       'Auswahl Loeschen - sollte das alte Bild sein
       Selection.Delete
       
       'Bild einfuegen
       ActiveSheet.Pictures.Insert(strMyPicture).Select
       Selection.Left = dblPos(1)
       Selection.Top = dblPos(2)
       'Selection.Width = dblPos(3)  'wenn gewünscht
       'Selection.Height = dblPos(4) 'wenn gewünscht
       
       'eingefügtes Bild in denHintergrund schieben
       Selection.ShapeRange.ZOrder msoSendToBack
     Else
       If MsgBox("Es wurde kein Ersatzbild gewählt." & vbNewLine & _
                 "Soll das alte Bild gelöscht werden?", _
                 vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
         Selection.Delete
       End If
     End If
   Else
     MsgBox "Es wurde kein zu ersetzendes Bild ausgewählt!", vbInformation + vbOKOnly
   End If
End Sub

Gruß Uwe

[Frihai]

Hallo Uwe!

Das ist die perfekte LÖSUNG!!!!

Vielen lieben Dank!

Lg
Frihai