Private Sub Worksheet_Change(ByVal Target As Range)
Dim objShape As Shape
Dim strPath As String
If Target.Address = "$W$12" Then
For Each objShape In Shapes
If objShape.TopLeftCell.Address = "$AP$11" Then Call objShape.Delete
Next
strPath = "C:\Users\NB01\Documents\HR-Manager\DATEN & VORLAGEN\Mitarbeiter Fotos\" & Target.Text & ".jpg"
If Dir$(strPath) vbNullString Then
Call Shapes.AddPicture(Filename:=strPath, _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=Range("AP11").Left, Top:=Range("AP11").Top, _
Width:=Application.CentimetersToPoints(4), _
Height:=Application.CentimetersToPoints(5))
Else
Call MsgBox("DasFoto für diesen Mitarbeiter wurde nicht gefunden.", vbExclamation, "Hinweis")
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objShape As Shape
Dim strPath As String
If Target.Address = "$A$12" Then
With Worksheets("Dashboard") '############### Anpassen !!! ###############
For Each objShape In .Shapes
If objShape.TopLeftCell.Address = "$AP$11" Then Call objShape.Delete
Next
strPath = "C:\Users\NB01\Documents\HR-Manager\DATEN & VORLAGEN\Mitarbeiter Fotos\" & Target.Text & ".jpg"
If Dir$(strPath) vbNullString Then
Call .Shapes.AddPicture(Filename:=strPath, _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=.Range("AP11").Left, Top:=.Range("AP11").Top, _
Width:=Application.CentimetersToPoints(4), _
Height:=Application.CentimetersToPoints(5))
Else
Call MsgBox("Das Foto für diesen Mitarbeiter wurde nicht gefunden.", vbExclamation, "Hinweis")
End If
End With
End If
End Sub
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim objShape As Shape
Dim strPath As String
If Target.CompactLayoutRowHeader = "SUFIX" Then
With Worksheets("Startseite")
For Each objShape In .Shapes
If objShape.TopLeftCell.Address = "$AP$11" Then Call objShape.Delete
Next
If Target.DataBodyRange.Value2(1, 1) "(Leer)" Then
strPath = "C:\Users\NB01\Documents\HR-Manager\DATEN & VORLAGEN\Mitarbeiter Fotos\" & _
Target.DataBodyRange.Value2(1, 1) & ".jpg"
If Dir$(strPath) vbNullString Then
Call .Shapes.AddPicture(Filename:=strPath, _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=.Range("AP11").Left, Top:=.Range("AP11").Top, _
Width:=Application.CentimetersToPoints(4.2), _
Height:=Application.CentimetersToPoints(5.4))
Else
Call MsgBox("Das Foto für diesen Mitarbeiter wurde nicht gefunden.", vbExclamation, "Hinweis")
End If
End If
End With
End If
End Sub