Thema Datum  Von Nutzer Rating
Antwort
Rot Bilder einfügen
17.01.2024 17:14:39 Gast20240117
NotSolved
17.01.2024 18:28:46 Gast27775
NotSolved
18.01.2024 08:44:06 volti
*****
Solved
25.01.2024 13:55:19 Gast20240117
Solved

Ansicht des Beitrags:
Von:
Gast20240117
Datum:
17.01.2024 17:14:39
Views:
231
Rating: Antwort:
  Ja
Thema:
Bilder einfügen

Hallo zusammen,

 

wenn ich das folgende Makro verwende, werden alle Bilder wie gewünscht eingefügt.

Wenn ich die Datei intern versende funktioniert auch alles wie gewünscht.

 

Wenn ich allerdings die Datei an externe versende, kommt anstelle der Bilder folgende Fehlermeldung:

"Das verknüpfte Bild kann nicht angezeigt werden. Möglicherweise wurde die Datei verschoben, umbenannt oder gelöscht. Stellen Sie sicher, dass die Verknüpfung auf die korrekte Datei und den korrekten Speicherort zeigt."

 

Wie muss ich das Makro umschreiben, dass die Bilder so in die Excel integriert werden, dass diese auch beim Versand an externe bestehen bleiben?

 

Option Explicit

Sub Bild_Einfügen()

'**********************************************
'Bilder aus einem bestimmten Bereich löschen
Dim rngPic As Range
Dim pic As Picture

Set rngPic = Range("A4:A2000")

For Each pic In ActiveSheet.Pictures
Debug.Print pic.Name; vbTab; pic.TopLeftCell.Address
If Not Intersect(pic.TopLeftCell, rngPic) Is Nothing Then
pic.Delete
End If
Next pic
'**********************************************

'**********************************************
'Zell-Inhalte aus einem bestimmten Bereich löschen
Tabelle1.Range("A4:A2000").ClearContents
'**********************************************

Dim i As Integer

'For-Schleife für alle Zeilen
For i = 4 To 2000

    'Zeile befüllt?
    If Tabelle1.Cells(i, 2).Value <> "" Then
    
    'Pfad nicht vorhanden
    If Dir$(Tabelle1.Cells(i, 2).Value) = "" Then
    Tabelle1.Cells(i, 1).Value = "X"
 
    Else 'Bild einfügen
        With Tabelle1.Pictures.Insert(Tabelle1.Cells(i, 2).Value)
            .Height = 60
            .Top = Tabelle1.Cells(i, 1).Top + (Tabelle1.Cells(i, 1).Height - .Height) / 2
            .Left = Tabelle1.Cells(i, 1).Left + (Tabelle1.Cells(i, 1).Width - .Width) / 2
            .Placement = xlMoveAndSize
        End With
        
    End If

    End If

Next i

End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Bilder einfügen
17.01.2024 17:14:39 Gast20240117
NotSolved
17.01.2024 18:28:46 Gast27775
NotSolved
18.01.2024 08:44:06 volti
*****
Solved
25.01.2024 13:55:19 Gast20240117
Solved