Bild einfügen
07.10.2013 09:14:39
Andreas
Ich habe mal ne Frage
Ich füge mit einem Code nach Eingabe einer Artikelnummer in Spalte "D" ein dazugehöriges Bild ein.
Dieses funktioniert auch klasse.
Ich möchte gern diese Funktion auch auf eine weitere Eingabe in Spalte "T" erweitern und weiss
leider nicht, wie ich den Code dafür ändern muss.
Vielleicht kann jemand mal auf den Code sehen und mir auf die Sprünge helfen.
Mein Dank wäre Euch gewiss.
Andreas
Option Explicit
Const strExt As String = ".jpg"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strFileName As String, Picture As Object
On Error Resume Next
Me.Shapes("picture").Delete
On Error GoTo 0
If Target.Count > 1 Then Exit Sub
' bereich, wo eine Zahl angegeben wird ( hier Spalte D )
If Not Intersect(Target, Range("D:D")) Is Nothing Then
' Bild löschen wenn target leer
If Target = "" Then
Bild_löschen (Target.Offset(3, 0).Address(False, False))
Exit Sub
End If
strFileName = ThisWorkbook.Path & "\" & Target.Text & strExt
If Dir(strFileName) "" Then
Set Picture = ActiveSheet.Pictures.Insert(strFileName)
' Größe des Bildes - Platzierung des Bildes von Eingabe fekd aus !
With Picture
.Name = Target.Offset(3, 0).Address(False, False) & "_" & Target.Text
.Left = Target.Offset(3, 0).Left
.Top = Target.Offset(3, 0).Top
Call Maß(Picture, 40)
End With
End If
End If
End Sub
Dim V As Double
With SH
If .Height > .Width Then
V = .Height / .Width
If Höhe = 0 Then
.Width = Breite
.Height = Breite * V
Else
.Height = Höhe
.Width = Höhe / V
End If
Else
V = .Width / .Height
If Höhe = 0 Then
.Width = Breite
.Height = Breite / V
Else
.Height = Höhe
.Width = Höhe * V
End If
End If
End With
End Sub
Public Sub Bild_löschen(rng As String)
Dim SH As Shape
For Each SH In ActiveSheet.Shapes
If InStr(1, SH.Name, "_", 1) 0 Then
If Left(SH.Name, InStr(1, SH.Name, "_", 1) - 1) = rng Then SH.Delete
End If
Next SH
End Sub