Anpassung Bildname in Zelle Makro von Tino
Tino
Bei folgende Makro wird ein bild eingfügt in betreffende Zelle mit Doppelklick.
Gerne hatte ich die möglichkeit das der Bildname auch ausgelesen wird.
Also in gleiche Zelle mit Doppelklick komt der Bildname
und eine Zelle darunter wird bild positioniert.
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
Freundlichen Grüsse
Hans Crienen