I am using the following function and Sub to copy pictures from an excel sheet to a folder on my computer. I found the function while googling, so I cant claim to totally understand it.

The problem is that my count Activesheets.Pictures is 24 but only 17 are copied. I am thinking it is because the function copys bitmaps and not toher types of files, although I am not totally sure, just a guess


Code:
Option Explicit
 
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
Private Type uPicDesc
    Size As Long
    Type As Long
        hPic As Long
        hPal As Long
    End Type
     
    Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
    Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
    Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
     
    Function PictureFromObject(Target As Object) As IPictureDisp
        Dim hPtr As Long, PicType As Long, hCopy As Long
         
        Const CF_BITMAP = 2
        Const CF_PALETTE = 9
        Const CF_ENHMETAFILE = 14
        Const IMAGE_BITMAP = 0
        Const LR_COPYRETURNORG = &H4
        Const PICTYPE_BITMAP = 1
        Const PICTYPE_ENHMETAFILE = 4
        Target.CopyPicture
        PicType = IIf(IsClipboardFormatAvailable(CF_BITMAP) <> 0, CF_BITMAP, CF_ENHMETAFILE)
        If IsClipboardFormatAvailable(PicType) <> 0 Then
            If OpenClipboard(0) > 0 Then
                hPtr = GetClipboardData(PicType)
                If PicType = CF_BITMAP Then
                    hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
                Else
                    hCopy = CopyEnhMetaFile(hPtr, vbNullString)
                End If
                CloseClipboard
                If hPtr <> 0 Then
                    Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPictureDisp
                     
                    With IID_IDispatch
                        .Data1 = &H7BF80980
                        .Data2 = &HBF32
                        .Data3 = &H101A
                        .Data4(0) = &H8B
                        .Data4(1) = &HBB
                        .Data4(2) = &H0
                        .Data4(3) = &HAA
                        .Data4(4) = &H0
                        .Data4(5) = &H30
                        .Data4(6) = &HC
                        .Data4(7) = &HAB
                    End With
                     
                    With uPicInfo
                        .Size = Len(uPicInfo)
                        .Type = IIf(PicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)
                        .hPic = hCopy
                    End With
                     
                    OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
                    Set PictureFromObject = IPic
                End If
            End If
        End If
    End Function

Code:
Private Sub CommandButton2_Click()

Dim pic As Picture
Dim i As Integer
Dim str As String
Dim path As String
path = "C:\Documents and Settings\Bill\My Documents\RealtyCompLogos\"

For Each pic In ActiveSheet.Pictures

str = pic.Name

MsgBox str & " of" & " " & ActiveSheet.Pictures.Count


On Error Resume Next
 SavePicture PictureFromObject(ActiveSheet.Pictures(str)), path & pic.Name '& ".bmp"
On Error GoTo 0

Next pic

End Sub
Does anyone have any idea or understanding of the function or the reason why I am only getting 17 pictures when there are 24 ?

Thanks for any help