Bild per Makro einfügen

Hallo zusammen!
Ich habe ein Problem, das mich zur Verzweiflung treibt und ihr könnt mir da bestimmt helfen:
Ich habe ich Excel 2003 ein Makro geschrieben, mit dem ich in Excel per Knopfdruck ein Bild in die Zelle B7 einfügen kann. Das hat super funktioniert. Jetzt möchte ich genau das selbe Makro in Excel 2007 verwenden und es funktioniert nur noch teilweise. Es fügt mir zwar das Bild ein, jedoch nicht mehr in Zelle B7.
Kann mir irgendjemand sagen, was ich am Code ändern muss, damit er das verdammte Ding wieder richtig platziert?
Hier der Code:
Sub Bilder_einfügen()
Dim Object_ID As String
Dim Pfad_Datei As String
Dim Pfad_Bild As String
Dim Maxi As Integer
'Objektphoto_1
Sheets("Template").Range("B7").Select
Pfad_Datei = ActiveWorkbook.Path
Pfad_Bild = C:\Bilder\1.jpg"
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 327.75
Selection.ShapeRange.Width = 435.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 140#
Selection.ShapeRange.Width = 186.17
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Sheets("Template").Range("Q1").Select
Danke schonmal im Voraus & beste Grüße,
Nico

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Bilder_einfügen() Dim Pfad_Bild As String, rngPicCell As Range 'Pfad zum Bild Pfad_Bild = "C:\Bilder\1.jpg" 'Tabelle anpassen With Sheets("Template") 'Zelle anpassen Set rngPicCell = .Range("B7") 'Bild in Excel laden und Formatieren With .Pictures.Insert(Pfad_Bild) .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.Height = 140# .ShapeRange.Width = 186.17 .ShapeRange.Rotation = 0# .ShapeRange.Fill.Visible = msoFalse .ShapeRange.Fill.Solid .ShapeRange.Line.Weight = 0.75 .ShapeRange.Line.DashStyle = msoLineSolid .ShapeRange.Line.Style = msoLineSingle .ShapeRange.Line.Visible = msoTrue .ShapeRange.Line.ForeColor.SchemeColor = 64 .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) .Top = rngPicCell.Top .Left = rngPicCell.Left End With End With End Sub

Sub Bilder_einfügen() Dim Pfad_Bild As String, rngPicCell As Range 'Pfad zum Bild Pfad_Bild = "C:\Bilder\1.jpg" 'Tabelle anpassen With Sheets("Template") 'Zelle anpassen Set rngPicCell = .Range("B7") 'Bild in Excel laden und Formatieren With .Pictures.Insert(Pfad_Bild) .ShapeRange.Height = 140# .ShapeRange.Width = 186.17 .ShapeRange.Fill.Solid .ShapeRange.Line.Weight = 0.75 .ShapeRange.Line.DashStyle = msoLineSolid .ShapeRange.Line.Style = msoLineSingle .ShapeRange.Line.Visible = msoTrue .ShapeRange.Line.ForeColor.SchemeColor = 64 .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) .Top = rngPicCell.Top + .ShapeRange.Line.Weight .Left = rngPicCell.Left + .ShapeRange.Line.Weight End With End With End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.Dialogs(xlDialogInsertPicture).Show 2. und wenn möglichh .ShapeRange.Line.ForeColor.SchemeColor = 64 über eingabe wert im _ zelle a1 ansteuern. Code von Tino Sub Bilder_einfügen() Dim Pfad_Bild As String, rngPicCell As Range 'Pfad zum Bild Pfad_Bild = "C:\Bilder\1.jpg" 'Tabelle anpassen With Sheets("Template") 'Zelle anpassen Set rngPicCell = .Range("B7") 'Bild in Excel laden und Formatieren With .Pictures.Insert(Pfad_Bild) .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.Height = 140# .ShapeRange.Width = 186.17 .ShapeRange.Rotation = 0# .ShapeRange.Fill.Visible = msoFalse .ShapeRange.Fill.Solid .ShapeRange.Line.Weight = 0.75 .ShapeRange.Line.DashStyle = msoLineSolid .ShapeRange.Line.Style = msoLineSingle .ShapeRange.Line.Visible = msoTrue .ShapeRange.Line.ForeColor.SchemeColor = 64 .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) .Top = rngPicCell.Top .Left = rngPicCell.Left End With End With End Sub

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim sZiel$ Cancel = True sZiel = Application.GetOpenFilename("Bilder (*.jpg;*.gif;*.bmp),*.jpg;*.gif;*.bmp") If sZiel <> CStr(False) Then If IsNumeric(Range("A1").Value) Then Load_Picture Target, Range("A1").Value, sZiel Else MsgBox "In A1 steht keine Zahl!", vbExclamation End If End If End Sub

Option Explicit Sub Load_Picture(rngPicCell As Range, lngSchemeColor As Long, Pfad_Bild$) 'Tabelle anpassen With Sheets(rngPicCell.Parent.Name) 'Zelle anpassen 'Bild in Excel laden und Formatieren With .Pictures.Insert(Pfad_Bild) .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.Height = 140# .ShapeRange.Width = 186.17 .ShapeRange.Rotation = 0# .ShapeRange.Fill.Visible = msoFalse .ShapeRange.Fill.Solid .ShapeRange.Line.Weight = 0.75 .ShapeRange.Line.DashStyle = msoLineSolid .ShapeRange.Line.Style = msoLineSingle .ShapeRange.Line.Visible = msoTrue .ShapeRange.Line.ForeColor.SchemeColor = lngSchemeColor .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) .Top = rngPicCell.Top + .ShapeRange.Line.Weight .Left = rngPicCell.Left + .ShapeRange.Line.Weight End With End With End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" "Application.Dialogs(xlDialogInsertPicture).Show" 2. und wenn möglichh .ShapeRange.Line.ForeColor.SchemeColor = 64 über eingabe wert im _ zelle a1 ansteuern. Code von Tino Sub Bilder_einfügen() Dim Pfad_Bild As String, rngPicCell As Range 'Pfad zum Bild Pfad_Bild = "C:\Bilder\1.jpg" 'Tabelle anpassen With Sheets("Template") 'Zelle anpassen Set rngPicCell = .Range("B7") 'Bild in Excel laden und Formatieren With .Pictures.Insert(Pfad_Bild) .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.LockAspectRatio = msoTrue .ShapeRange.Height = 140# .ShapeRange.Width = 186.17 .ShapeRange.Rotation = 0# .ShapeRange.Fill.Visible = msoFalse .ShapeRange.Fill.Solid .ShapeRange.Line.Weight = 0.75 .ShapeRange.Line.DashStyle = msoLineSolid .ShapeRange.Line.Style = msoLineSingle .ShapeRange.Line.Visible = msoTrue .ShapeRange.Line.ForeColor.SchemeColor = 64 .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) .Top = rngPicCell.Top .Left = rngPicCell.Left End With End With End Sub

Hallo,
kommt als Code in die Tabelle

Option Explicit 
 
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
Dim sZiel$ 
Cancel = True 
sZiel = Application.GetOpenFilename("Bilder (*.jpg;*.gif;*.bmp),*.jpg;*.gif;*.bmp") 
If sZiel <> CStr(False) Then 
    If IsNumeric(Range("A1").Value) And IsNumeric(Range("B1").Value) Then 
        Load_Picture Target, Range("A1").Value, Range("B1").Value, sZiel 
    Else 
        MsgBox "In A1 oder B1 steht keine Zahl!", vbExclamation 
    End If 
End If 
End Sub

kommt als Code in ein Modul

Option Explicit 
  
Sub Load_Picture(rngPicCell As Range, lngSchemeColor As Long, sngLine_Weight As Single, Pfad_Bild$) 
'Tabelle anpassen 
With Sheets(rngPicCell.Parent.Name) 
    'Bild in Excel laden und Formatieren 
    With .Pictures.Insert(Pfad_Bild) 
        .ShapeRange.LockAspectRatio = msoTrue 
        .ShapeRange.LockAspectRatio = msoTrue 
        .ShapeRange.Height = 140# 
        .ShapeRange.Width = 186.17 
        .ShapeRange.Rotation = 0# 
        .ShapeRange.Fill.Visible = msoFalse 
        .ShapeRange.Fill.Solid 
        .ShapeRange.Line.Weight = sngLine_Weight 
        .ShapeRange.Line.DashStyle = msoLineSolid 
        .ShapeRange.Line.Style = msoLineSingle 
        .ShapeRange.Line.Visible = msoTrue 
        .ShapeRange.Line.ForeColor.SchemeColor = lngSchemeColor 
        .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) 
        .Top = rngPicCell.Top + .ShapeRange.Line.Weight 
        .Left = rngPicCell.Left + .ShapeRange.Line.Weight 
    End With 
  
End With 
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bild per Makro einfügen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread