VBA ændre størrelse af billede

Jeg har på ingen måde testet det, men det kunne nok se sådan ud:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim shpTemp As Shape
    If Target.Address = "$A$1" Then
        Select Case Target
            Case 1
                ActiveSheet.Pictures.Delete
                Set shpTemp = ActiveSheet.Pictures.Insert("Y:\Logoer\logo1.jpg")
            Case 2
                ActiveSheet.Pictures.Delete
                Set shpTemp = ActiveSheet.Pictures.Insert("Y:\Logoer\logo2.jpg")
            Case 3
                ActiveSheet.Pictures.Delete
                Set shpTemp = ActiveSheet.Pictures.Insert("Y:\Logoer\logo3.jpg")
            Case Else
                ActiveSheet.Pictures.Delete
        End Select
        shpTemp.Height = 50
        shpTemp.Width = 50
        Set shpTemp = Nothing
    End If
End Sub

Kig lige på denne og hjælpen på AddPicture
Addpicture's sidste 2 parametre bestemmer størrelsen


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim shptemp As Shape
    If Target.Address = "$A$1" Then
        ActiveSheet.Pictures.Delete
        Select Case Target
            Case 1
               
              Set shptemp = ActiveSheet.Shapes.AddPicture("Y:\Logoer\logo1.jpg", True, True, 100, 100, 50, 50)
            Case 2
                Set shptemp = ActiveSheet.Shapes.AddPicture("Y:\Logoer\logo2.jpg", True, True, 100, 100, 50, 50)
               
            Case 3
                Set shptemp = ActiveSheet.Shapes.AddPicture("Y:\Logoer\logo3.jpg", True, True, 100, 100, 50, 50)
             
            Case Else
              GoTo exithere
        End Select
'her ændrer jeg størrelse igen
        shptemp.Height = 100
        shptemp.Width = 100
        Set shptemp = Nothing
exithere:
    End If
End Sub

Hvis du også vil styre indsættelsesstedet (her styres efter C3):

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim shpTemp As Shape, lTop As Long, lTeft As Long, lWidth As Long, lHeight As Long
    If Target.Address = "$A$1" Then
        lTop = Range("C3").Top
        lleft = Range("C3").Left
        lWidth = 50
        lHeight = 50
        ActiveSheet.Pictures.Delete
        Select Case Target
            Case 1
              Set shpTemp = ActiveSheet.Shapes.AddPicture("Y:\Logoer\logo1.jpg", True, False, lleft, lTop, lWidth, lHeight)
            Case 2
                Set shpTemp = ActiveSheet.Shapes.AddPicture("Y:\Logoer\logo2.jpg", True, False, lleft, lTop, lWidth, lHeight)
            Case 3
                Set shpTemp = ActiveSheet.Shapes.AddPicture("Y:\Logoer\logo3.jpg", True, False, lleft, lTop, lWidth, lHeight)
            Case Else
              Exit Sub
        End Select
        Set shpTemp = Nothing
    End If
End Sub

lukketid Jan :-)

Sorry, tak for hjælpen.
Smid et svar begge to.

Lukket.