.png image file won't insert via macro

[DFragnDragn]

Hi All,

Of all my image file extensions provided for, .png is the only one that refuses to import.

It will however insert manually with Insert/Picture/From File. It is available through my macro's "getopenfilename", but that's as far as she'll go.

I really need to provide transparency image import beyond the limited 256 color .gif method.

Here's my code. I've scoured it and can't see the issue.

Any help much appreciated...

Option Explicit
Private Sub GetLogo_Click()
    Dim vFile As Variant
    Dim Pic As Picture
    Dim pic2 As Picture
    Dim pic3 As Picture
    Dim pic4 As Picture
    Dim r As Range
    Dim r2 As Range
    Dim r3 As Range
    Dim r4 As Range
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim ws4 As Worksheet
    Dim shp As Shape
    Dim shp2 As Shape
    Dim shp3 As Shape
    Dim shp4 As Shape

    On Error GoTo ErrorTrap
    vFile = Application.GetOpenFilename("Logo Image Files (*.jpg; *.jpeg; *.emf; *.png; *.rle; *.jib; .wmf; *.gif; *.bmp), *.jpg; *.jpeg; *.emf; *.png; *.rle; *.jib; .wmf; *.gif; *.bmp", , _
                                        Title:="-  Please Select Your Logo Image File")
    If vFile <> False Then
        Image1.Picture = LoadPicture(vFile)
        'LastSelectedFilePath = vFile   'did not function on new pc
    End If

   [COLOR=SeaGreen]'................................................................Logo sht image insert[/COLOR]
    ThisWorkbook.Worksheets("Logo").Unprotect Password:=""
    Application.ScreenUpdating = False
    With ws
        Set ws = ThisWorkbook.Worksheets("Logo")
        Set r = ws.Range("H12:M33")
        For Each shp In ws.Shapes
            Debug.Print shp.Type
            If shp.Type = msoPicture Then
                shp.Delete
            End If
        Next shp
    End With
    [COLOR=SeaGreen]'................................................................Estimate sht image [/COLOR]insert
    ThisWorkbook.Worksheets("Estimate").Unprotect Password:=""
    With ws2
        Set ws2 = ThisWorkbook.Worksheets("Estimate")
        Set r2 = ws2.Range("C22:H32")
        For Each shp2 In ws2.Shapes
            Debug.Print shp2.Type
            If shp2.Type = msoPicture Then
                shp2.Delete
            End If
        Next shp2
    End With
   [COLOR=SeaGreen] '................................................................View & Print sht image [/COLOR]insert x2
    ThisWorkbook.Worksheets("View & Print").Unprotect Password:=""
    With ws3
        Set ws3 = ThisWorkbook.Worksheets("View & Print")
        Set r3 = ws3.Range("G2:H10") 'And .Range("G102:H110")
        For Each shp3 In ws3.Shapes
            Debug.Print shp3.Type
            If shp3.Type = msoPicture Then
                shp3.Delete
            End If
        Next shp3
    End With
    
    ThisWorkbook.Worksheets("View & Print").Unprotect Password:=""
    With ws4
        Set ws4 = ThisWorkbook.Worksheets("View & Print")
        Set r4 = ws4.Range("G97:H105")
        For Each shp4 In ws4.Shapes
            Debug.Print shp4.Type
            If shp4.Type = msoPicture Then
                shp4.Delete
            End If
        Next shp4
    End With
    [COLOR=SeaGreen]'.................................................................Logo sht adjust/size[/COLOR]
    Set Pic = ws.Pictures.Insert(vFile)
    With Pic.ShapeRange
        .LockAspectRatio = msoTrue
        If .Width > .Height - 4 Then
            .Width = r.Width - 4
            If .Height > r.Height - 4 Then .Height = r.Height - 4
        Else
            .Height = r.Height - 4
            If .Width > r.Width - 4 Then .Width = r.Width - 4
        End If
    End With
    With Pic
        .Left = r.Left + ((r.Width - .Width) / 2)
        .Top = r.Top + ((r.Height - .Height) / 2)
    End With
   [COLOR=SeaGreen] '.................................................................Estimate sht [/COLOR]adjust/size
    Set pic2 = ws2.Pictures.Insert(vFile)
    With pic2.ShapeRange
        .LockAspectRatio = msoTrue
        If .Width > .Height - 4 Then
            .Width = r2.Width - 4
            If .Height > r2.Height - 4 Then .Height = r2.Height - 4
        Else
            .Height = r2.Height - 4
            If .Width > r2.Width - 4 Then .Width = r2.Width - 4
        End If
    End With
    With pic2
        .Left = r2.Left + ((r2.Width - .Width) / 2)
        .Top = r2.Top + ((r2.Height - .Height) / 2)
    End With
    [COLOR=SeaGreen]'.................................................................View & Print sht [/COLOR]adjust/size x2
    Set pic3 = ws3.Pictures.Insert(vFile)
    With pic3.ShapeRange
        .LockAspectRatio = msoTrue
        If .Width > .Height - 4 Then
            .Width = r3.Width - 4
            If .Height > r3.Height - 4 Then .Height = r3.Height - 4
        Else
            .Height = r3.Height - 4
            If .Width > r3.Width - 4 Then .Width = r3.Width - 4
        End If
    End With
    With pic3
        .Left = r3.Left + ((r3.Width - .Width) / 2)
        .Top = r3.Top + ((r3.Height - .Height) / 2)
    End With


    Set pic4 = ws4.Pictures.Insert(vFile)
    With pic4.ShapeRange
        .LockAspectRatio = msoTrue
        If .Width > .Height - 4 Then
            .Width = r4.Width - 4
            If .Height > r4.Height - 4 Then .Height = r4.Height - 4
        Else
            .Height = r4.Height - 4
            If .Width > r4.Width - 4 Then .Width = r4.Width - 4
        End If
    End With
    With pic4
        .Left = r4.Left + ((r4.Width - .Width) / 2)
        .Top = r4.Top + ((r4.Height - .Height) / 2)
    End With
   [COLOR=SeaGreen] '.................................................................[/COLOR]
ErrorTrap:
    On Error GoTo 0
    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
        Case "Logo", "Estimate", "View & Print": ws.Protect Password:=""
        Case Else
        End Select
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[theta]

Nothing obvious that I can see....have you tried running segments in the immediate window, or using MSGBOX to report variable values at each stage to see where it fails?