364 Aufrufe
Gefragt in Tabellenkalkulation von
Ich habe in Exel eine Tabelle erstellt,

Spalte A Position, Spalte B Artikelnummer, Spalte C Bild

Die Makro legt das Bild in Spalte C, den Namen holt sie sich aus Spalte B.

Das klappt auch alles, nur sind die eingesetzten Bilder und mit unserem Server verknüpft. Ich brauche die Bilder aber in der exeldatei eingebettet, so dass ich die Datei per mail versenden kann und die Bilder beim Kunden angezeigt werden.

Hier der makro-Code

Sub Makro_Reihe1()
Dim Bild As Object, Zelle As Range
Dim i As Integer
For i = 2 To 10000
If ActiveSheet.Range("B" & i).Value > 0 Then
On Error Resume Next
ActiveSheet.Range("C" & i).Select
Set Zelle = ActiveCell
Set Bild = ActiveSheet.Pictures.Insert("I:\3.00 Verkauf & Vertrieb\JPG's\" & Range("B" & i).Value & ".JPG") '
With Bild
.Placement = 2
.Left = Zelle.Left
.Top = Zelle.Top
.Width = Zelle.Width
.Height = Zelle.Height
End With
End If
Next
End Sub

Wie muss der code heißen, so dass die Bilder eingebettet werden oder kann ich nachträglich das noch automatisiert tun?

Ich freue mich auf Eure Hilfe, vielen lieben Dank Nina

10 Antworten

0 Punkte
Beantwortet von

Hallo Nina,

ich verwende AddPicture (hier:)

https://docs.microsoft.com/de-DE/office/vba/api/Excel.Shapes.AddPicture

Damit kann gesteuert werden, ob das Bild verknüpft oder eingebettet werden soll.

Zitat: "Beispiel

In diesem Beispiel wird myDocument ein bild, das aus Music.bmp erstellt wurde, hinzufügt. Das eingefügte Bild ist mit der Datei verknüpft, aus der es erstellt wurde, und wird mit myDocument gespeichert

Set myDocument = Worksheets(1) 
myDocument.Shapes.AddPicture _ 
    "c:\microsoft office\clipart\music.bmp", _ 
    True, True, 100, 100, 70, 70

Gruss
Busmaster
0 Punkte
Beantwortet von
Hallo Busmaster, danke dir. Das ist sicher super, wenn man ein bestimmtes Bild einfügen will. ich muss aber in eine Liste mehr als 100 Bilder einfügen und deshalb wünsche ich mir, dass dies automatisch ausgelesen wird und dann eingefügt wird. Hast du dafür auch eine Idee?

Liebe Grüße

Nina
0 Punkte
Beantwortet von

Hallo Nina,

die Idee war Deine Zeile

Set Bild = ActiveSheet.Pictures.Insert("I:\3.00 Verkauf & Vertrieb\JPG's\" & Range("B" & i).Value & ".JPG") '

zu ersetzen

Set Bild = ActiveSheet.Pictures.Insert("I:\3.00 Verkauf & Vertrieb\JPG's\" & Range("B" & i).Value & ".JPG", , msoFalse, msoTrue, 0, 0, -1, 1) '

Ich damit ging es. Ich habe eine ähnliche Lösung, aber die zu groß zum einbetten.
Gruß
Busmaster
0 Punkte
Beantwortet von
Danke Busmaster,

vielen Dank für deine Hilfe -

leider passiert dann aber garnichts. Kein Bild wird eingesetzt. Verstehe auch nicht warum.

Hatte das vorher schon mal so probiert aber ohne Erfolg. Manno

Trotzdem danke
0 Punkte
Beantwortet von

Hallo Nina,

ich hatte einen Copy&Paste Fehler. Probier's mal so:

Set Bild = ActiveSheet.Shapes.AddPicture("I:\3.00 Verkauf & Vertrieb\JPG's\" & Range("B" & i).Value & ".JPG", msoFalse, msoTrue, 0, 0, -1, 1)

0 Punkte
Beantwortet von
Ja danke dir, das habe ich gestern auch gesehen aber leider auch mit add funktioniert es nicht.

Guck mal siehst du einen anderen Fehler?

Vielen dank für deine Unterstützung, bin schon glücklich nicht ganz allein hier zu tüfteln.

anbei meine Makro:

Sub Makro_Reihe1()
Dim Bild As Object, Zelle As Range
Dim i As Integer
For i = 2 To 10000
If ActiveSheet.Range("B" & i).Value > 0 Then
On Error Resume Next
ActiveSheet.Range("C" & i).Select
Set Zelle = ActiveCell
Set Bild = ActiveSheet.Shapes.AddPicture("I:\3.00 Verkauf & Vertrieb\JPG's\" & Range("B" & i).Value & ".JPG", , msoFalse, msoTrue, 0, 0, -1, 1) '
With Bild
.Placement = 2
.Left = Zelle.Left
.Top = Zelle.Top
.Width = Zelle.Width
.Height = Zelle.Height
End With
End If
Next
    ActiveWorkbook.Save
End Sub
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
 
Beste Antwort

Hallo Nina,

probiere es mal so:

Sub Makro_Reihe1()
Dim i As Integer
Dim Zelle As Range

For i = 2 To 10000
   If ActiveSheet.Range("B" & i).Value > 0 Then
    On Error Resume Next
    Set Zelle = Range("C" & i)
    'Bild in Spalte C einfügen
    '.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)
    ActiveSheet.Shapes.AddPicture "I:\3.00 Verkauf & Vertrieb\JPG's\" & Range("B" & i).Value & ".JPG", msoFalse, msoTrue, Zelle.Left, Zelle.Top, Zelle.Width, Zelle.Height
  End If
Next i
  ActiveWorkbook.Save
End Sub


Gruß

M.O-

0 Punkte
Beantwortet von
Hallo, ich habe kein Excel (weiß aber, wie man es schreibt) und keine Ahnung von VB-Scripten. Aber ich weiß, dass keiner eurer Lösungsansätze zum Erfolg führen kann. Ab gesehen davon, dass ein PC normalerweise nur ganz kurz funktionieren wird, wenn der Benutzer das Ausführen Scripten aus E-Mails zulässt, enthält das Script doch keinen brauchbaren Adressen. Der Pfad "I:\3.00 Verkauf & Vertrieb\JPG's\" existiert doch beim Empfänger gar nicht. Außerdem ist das ganze an so viele Voraussetzungen geknüpft, dass du dir die Mail wohl selbst schicken müsstest, dass es funktioniert. Der Empfänger muss Windows haben, Microsot Excel muss installiert sein und die Defaultanwendung für dein gewähltes Format sein. Schlimmstenfalls hast du deine Tabelle auch noch in einen HTML-Mail eingesetzt. Dann muss er natürlich auch das gleiche E-Mail-Programm von Microsoft benutzen wie du, alle Schutzmechanisman abschalten... Ich halte das nicht für eine sinnvolle Methode, sowas zu machen.
0 Punkte
Beantwortet von
Hallo,

bei mir laufen beide heute geposteten Varianten durch (mit angepassten Pfaden). Bei Ninas Variante gibt es Probleme, wenn der File nicht existiert oder der Name in Spalte B auf ".jpg" endet.

Gruss

Busmaster
0 Punkte
Beantwortet von

Es klappt, ich freue mich so.

Ihr seid die BESTEN!

Vielen Dank für eure Hilfe, komme aus dem Grinsen nicht mehr raus.

JUHU

Ich habe das jetzt so gemacht, wie vorgeschlagen:

Sub Makro_Reihe1()
Dim i As Integer
Dim Zelle As Range

For i = 2 To 10000
   If ActiveSheet.Range("B" & i).Value > 0 Then
    On Error Resume Next
    Set Zelle = Range("C" & i)
    'Bild in Spalte C einfügen
    '.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)
    ActiveSheet.Shapes.AddPicture "I:\3.00 Verkauf & Vertrieb\JPG's\" & Range("B" & i).Value & ".JPG", msoFalse, msoTrue, Zelle.Left, Zelle.Top, Zelle.Width, Zelle.Height
  End If
Next i
  ActiveWorkbook.Save
End Sub
...