INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Compile error Invalid use of property and Runtime Error 13 Type Mismatch

Compile error Invalid use of property and Runtime Error 13 Type Mismatch

Compile error Invalid use of property and Runtime Error 13 Type Mismatch

(OP)
I have an MS ACCESS 2002 database with a UserForm code as follows

CODE -->

Option Compare Database
Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
Private Type PICTDESC
        Size As Long
        Type As Long
    #If VBA7 Then
        hPic As LongPtr
        hPal As LongPtr
    #Else
        hPic As Long
        hPal As Long
    #End If
End Type

#If VBA7 Then
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
    Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Long, ByVal bErase As Long) As Long
    Private Declare PtrSafe Function MessageBeep Lib "user32" (ByVal wType As Long) As Long
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function PlaySoundAPI Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As LongPtr, ByVal dwFlags As Long) As Long
    
    Private lFrmHwnd As LongPtr

#Else
    Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long
    Private Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function PlaySoundAPI Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long

    Private lFrmHwnd As Long
#End If


Private Const PICTYPE_BITMAP = &H1
Private Const SRCCOPY = &HCC0020
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const SND_ASYNC = &H1
Private Const SND_FILENAME = &H20000
Private Const SND_LOOP = &H8
Private Const SND_PURGE = &H40

'Module level variables
Private oCol As Collection
Private oPic As Object

Private bScore As Boolean
Private bExit As Boolean
Private bAbort As Boolean

Private InitialFormLeft As Single
Private InitialFormTop As Single

Private lCounter As Long
Private lTotalImageParts As Long
Private lColumns As Long
Private lRows As Long

Private sLevel As String
Private sUserName As String

Private vFileName As Variant


Private Sub UserForm_Initialize()
    sUserName = InputBox("Please, enter your name", "Player Name")
    If Len(sUserName) = 0 And StrPtr(sUserName) <> 0 Then MsgBox "You must enter a player name", vbInformation: End
    If StrPtr(sUserName) = 0 Then End
End Sub

Private Sub UserForm_Activate()
    StartUpPosition = 2
    InitialFormLeft = Me.Left
    InitialFormTop = Me.Top
    Set oPic = frameSourcePic.Picture
    lFrmHwnd = FindWindow(vbNullString, Me.Caption)
    frameSourcePic.BorderStyle = fmBorderStyleSingle
    frameSourcePic.BorderColor = vbYellow
    With Me.ComboLevel
        .AddItem "Easy  " & " (3x6 Parts)"
        .AddItem "low  " & " (3x8 Parts)"
        .AddItem "Medium  " & "(4x10 Parts)"
        .AddItem "High  " & "(6x13 Parts)"
        .ListIndex = 0
    End With
    lblTimer.Caption = ""
    CBtnAbort.Enabled = False
    Call EnableControls(True)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If MsgBox("Are you sure you want to quit ?", vbQuestion + vbYesNo) = vbNo Then
        Cancel = 1
        Exit Sub
    End If
    bExit = True
End Sub


'***************************************************************************************************
'Event handlers of form's controls
Private Sub ComboLevel_Change()
    Select Case True
        Case UCase(ComboLevel.Value) Like "EASY*"
            lRows = 3
            lColumns = 6
        Case UCase(ComboLevel.Value) Like "LOW*"
            lRows = 3
            lColumns = 8
        Case UCase(ComboLevel.Value) Like "MEDIUM*"
            lRows = 4
            lColumns = 10
        Case UCase(ComboLevel.Value) Like "HIGH*"
            lRows = 6
            lColumns = 13
    End Select
    sLevel = UCase(ComboLevel.Value)
End Sub

Private Sub CBtnAbort_Click()
    Call EnableControls(False)
    bAbort = True
End Sub

Private Sub CBtnClose_Click()
    Unload Me
End Sub

Private Sub CBtnNewPic_Click()
    On Error GoTo errHandler
    
    
'Dim varFile As Variant
'Dim strSQL As String

With Application.FileDialog(dialogType:=3)
    .AllowMultiSelect = False 'Allow the user to make multiple selections in the dialog box.
 '  ' .Title = "Browse" 'Set the title of the dialog box.
  '  .Filters.Clear 'Clear out the current filters and add our own.
  '  .Filters.Add Description:="Images", Extensions:="*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png", Position:=1 'Make this filter the first item in the list.
  '  .Filters.Add Description:="All Files", Extensions:="*.*"
    If .Show = True Then 'Show the dialog box.

vFileName = .SelectedItems(1)

    Else
        'Cancel pressed.
    End If
End With

    
    
    
'    vFileName = Application.GetOpenFilename(FileFilter:="Picture Files (*.gif;*.jpg;*.jpeg;*.bmp),*.gif;*.jpg;*.jpeg;*.bmp", _
    Title:="Select Picture")
    If vFileName <> False Then
    frameSourcePic.Picture = LoadPicture(vFileName)
    Call DeletePreviousImages
    End If
    Exit Sub
errHandler:
    MsgBox Err.Description
End Sub

Private Sub CBtnStart_Click()
    Dim oImagePartCls As oImagePartCls
    Dim oTextBox  As MSForms.TextBox
    Dim tRect As RECT
    Dim tPt1 As POINTAPI, tPt2 As POINTAPI
    Dim BasePicframeHwnd As Long
    Dim lImgPartWidth As Long, lImgPartHeight As Long
    Dim lImgPartLeft As Long, lImgPartTop As Long
    Dim lColumn As Long, lRow As Long
    Dim lControlCounter As Long
    
    bScore = False
    bAbort = False
    Call EnableControls(False)
    BasePicframeHwnd = frameSourcePic.[_GethWnd]
    GetWindowRect BasePicframeHwnd, tRect
    tPt1.x = tRect.Left
    tPt1.y = tRect.Top
    tPt2.x = tRect.Right
    tPt2.y = tRect.Bottom
    If IsFormClipped(tPt1, tPt2) Then
        Me.Move InitialFormLeft, InitialFormTop
        GetWindowRect BasePicframeHwnd, tRect
    DoEvents
    End If
    Call DeletePreviousImages
    'add the image parts controls
    Set oCol = New Collection
    For lColumn = 1 To lRows
        For lRow = 1 To lColumns
            lControlCounter = lControlCounter + 1
            Set oImagePartCls = New oImagePartCls
            Set oImagePartCls.GetForm = Me
            Set oImagePartCls.PicturePart = Controls.Add("Forms.Image.1", "Image" & lControlCounter)
            With oImagePartCls.PicturePart
                .PictureSizeMode = fmPictureSizeModeStretch
                .BorderStyle = fmBorderStyleSingle
                .BorderColor = vbYellow
                .MousePointer = fmMousePointerSizeAll
                .Width = frameSourcePic.Width / lRows
                .Height = frameSourcePic.Height / lColumns
                .Left = frameSourcePic.Left + (((lRow - 1) * (frameSourcePic.Width + 20) / lRows))
                .Top = 20 + (((lColumn - 1) * (frameSourcePic.Height + 20) / lColumns))
                .ZOrder 0
                .ControlTipText = "Drag the Picture down to its corresponding empty frame below"
            End With
            oCol.Add oImagePartCls
        Next
    Next
     'add the textbox holder controls
    lControlCounter = 0
    For lRow = 1 To lColumns
        For lColumn = 1 To lRows
            lControlCounter = lControlCounter + 1
            Set oTextBox = Controls.Add("Forms.TextBox.1", "TextBox" & lControlCounter)
            With oTextBox
                .Enabled = False
                .BackStyle = fmBackStyleTransparent
                .BorderStyle = fmBorderStyleSingle
                .SpecialEffect = fmSpecialEffectEtched
                .Left = frameSourcePic.Left + frameSourcePic.Width + 80 + lColumn * frameSourcePic.Width / lRows
                .Top = frameSourcePic.Top + (lRow - 1) * frameSourcePic.Height / lColumns
                .Width = oImagePartCls.PicturePart.Width
                .Height = oImagePartCls.PicturePart.Height
                .ZOrder 1
            End With
        Next
    Next
    'randomly shuffle the image part controls
    lTotalImageParts = lColumns * lRows
    Me.Tag = lTotalImageParts
    ReDim iArray(1 To lTotalImageParts) As Integer  '
    Call ShufflePictureParts(lTotalImageParts, iArray)
    'set the Pic property of each image part
    lControlCounter = 0
    For lColumn = 1 To lColumns
        For lRow = 1 To lRows
            With tRect
                lImgPartWidth = (.Right - .Left) / lRows
                lImgPartHeight = (.Bottom - .Top) / lColumns
                lImgPartLeft = .Left + ((lRow - 1) * lImgPartWidth)
                lImgPartTop = .Top + ((lColumn - 1) * lImgPartHeight)
            End With
            lControlCounter = lControlCounter + 1
            Controls("image" & iArray(lControlCounter)).Tag = Controls("TextBox" & lControlCounter).Name
            CropPic lImgPartWidth, lImgPartHeight, lImgPartLeft, lImgPartTop, Me.Controls("image" & iArray(lControlCounter))
            InvalidateRect lFrmHwnd, 0, 0
        Next
    Next
    frameSourcePic.BorderStyle = fmBorderStyleSingle
    frameSourcePic.BorderColor = vbYellow
    Call UpdateTimerLabel
End Sub


'*************************************************************************************************
' Private Supporting routines

Private Sub UpdateTimerLabel()
    Dim ss As Long
    Dim mm As Long
    Dim hh As Long
    Dim sglTimer As Single
    Const WAV_FILE As String = "C:\WINDOWS\MEDIA\tada.WAV"
    
    sglTimer = Timer
    Do
        ss = Int(Timer - sglTimer)
        If ss = 60 Then mm = mm + 1: ss = 0: sglTimer = Timer
        If mm = 60 Then hh = hh + 1:  mm = 0: sglTimer = Timer
        lblTimer.Caption = Format(hh, "00") & " Hrs : " & Format(mm, "00") & " mins : " & Format(ss, "00") & " Secs"
        DoEvents
    Loop Until bExit Or bScore Or bAbort
    If bScore Then
        PlaySoundAPI WAV_FILE, ByVal 0&, SND_FILENAME Or SND_LOOP Or SND_ASYNC
        If MsgBox("Congratulations " & sUserName & "  !!" & vbCrLf & vbCrLf & _
        "You scored in : " & Format(hh, "00") & " Hrs : " & Format(mm, "00") & " mins : " & Format(ss, "00") & " Secs" & vbCrLf & _
        "Do you want to save this score to your scores history  ?", vbQuestion + vbYesNo) = vbYes Then
            Call SaveTheScore(hh, mm, ss)
        End If
        PlaySoundAPI WAV_FILE, ByVal 0&, SND_FILENAME Or SND_PURGE
    End If
    lblTimer.Caption = ""
    Call EnableControls(True)
    Call DeletePreviousImages
    Set frameSourcePic.Picture = oPic
End Sub

Private Sub SaveTheScore(ByVal hh As Long, mm As Long, ByVal ss As Long)
    Dim bProtection As Boolean
    
'    bProtection = ActiveSheet.ProtectContents
'    If bProtection Then
'        ActiveSheet.Unprotect
'    End If
'    With Cells(Cells.Rows.Count, 1).End(xlUp)
'        .Offset(1, 0) = sUserName
'        .Offset(1, 1) = Now
'        .Offset(1, 2) = IIf(vFileName = Empty, "Default Picture", vFileName)
'        .Offset(1, 3) = sLevel
'        .Offset(1, 4) = Format(hh, "00") & " Hrs : " & Format(mm, "00") & " mins : " & Format(ss, "00") & " Secs"
'    End With
'    If bProtection Then
'        ActiveSheet.Protect
'    End If
'    ThisWorkbook.Save
End Sub

Private Sub CropPic(ByVal nWidth, ByVal nHeight, ByVal x, ByVal y, DestCtrl As Image)

    #If VBA7 Then
        Dim hdc, hDCMemory, hBmp, OldBMP As LongPtr
    #Else
        Dim hdc, hDCMemory, hBmp, OldBMP As Long
    #End If
       
    Dim IID_IDispatch As GUID
    Dim uPicinfo As PICTDESC
    Dim IPic As IPicture

    hdc = GetDC(0)
    hDCMemory = CreateCompatibleDC(hdc)
    hBmp = CreateCompatibleBitmap(hdc, nWidth, nHeight)
    OldBMP = SelectObject(hDCMemory, hBmp)
    Call BitBlt(hDCMemory, 0, 0, nWidth, nHeight, hdc, x, y, SRCCOPY)
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    With uPicinfo
        .Size = Len(uPicinfo)
        .Type = PICTYPE_BITMAP
        .hPic = hBmp
        .hPal = 0
    End With
    OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic
    Set DestCtrl.Picture = IPic
    ReleaseDC 0, hdc
    DeleteObject OldBMP
    DeleteDC hDCMemory
End Sub

Private Sub ShufflePictureParts(ByVal NumOfPics, ByRef Arr() As Integer)
     Dim i As Integer, lRandomNumber As Integer, temp As Integer

    For i = 1 To NumOfPics
        Arr(i) = i
    Next i
    Randomize Timer
    For i = 1 To NumOfPics
        lRandomNumber = Int(Rnd * (UBound(Arr) - LBound(Arr) + 1) + LBound(Arr))
        temp = Arr(i)
        Arr(i) = Arr(lRandomNumber)
        Arr(lRandomNumber) = temp
    Next i
End Sub

Private Sub DeletePreviousImages()
    Dim i As Long
    Dim oCtl As Control
    
    On Error Resume Next
    If Not oCol Is Nothing Then
        For i = 1 To oCol.Count
            Controls.Remove Controls("Image" & i).Name
        Next
        For Each oCtl In Me.Controls
            If TypeName(oCtl) = "TextBox" Then
                Controls.Remove oCtl.Name
            End If
            If TypeName(oCtl) = "Image" Then
                Controls.Remove oCtl.Name
            End If
        Next
    End If
End Sub

Private Function IsFormClipped(tLeftTop As POINTAPI, tRightBottom As POINTAPI) As Boolean
    IsFormClipped = _
    tLeftTop.x <= 1 Or tLeftTop.y <= 1 Or tRightBottom.x >= GetSystemMetrics(SM_CXSCREEN) - 1 Or _
    tRightBottom.y >= GetSystemMetrics(SM_CYSCREEN) - 1
End Function

Private Sub EnableControls(ByVal Bool As Boolean)
    CBtnAbort.Enabled = Not Bool
    CBtnNewPic.Enabled = Bool
    CBtnStart.Enabled = Bool
    ComboLevel.Enabled = Bool
End Sub

'*************************************************************************************************************
' Public  Methods

Public Sub MsgbBeep()
    MessageBeep &H40&
End Sub

Public Sub FlashImagePart(ByVal Img As Image, ByVal ct As MSForms.TextBox)
    Dim i As Long
    Dim t As Single
    
    For i = 0 To 1
        Img.BorderStyle = fmBorderStyleSingle
        Img.BorderColor = vbRed
        t = Timer
        Do
            DoEvents
        Loop Until Timer - t >= 0.1
        Img.BorderStyle = fmBorderStyleNone
    Next
End Sub

Public Sub CheckIfSuccess()
    Dim oCtrl As Control
    Dim lCounter As Long
    
     For Each oCtrl In Me.Controls
        If TypeName(oCtrl) = "Image" Then
            If InStr(1, oCtrl.Tag, "Success") Then
                lCounter = lCounter + 1
                If lCounter = lTotalImageParts Then
                    bScore = True
                End If
            End If
        End If
    Next
End Sub 

And a Class module code as follows

CODE -->

Option Compare Database
Option Explicit

Public WithEvents PicturePart As MSForms.Image
Private initialY As Single, initialX As Single
Private oUForm As Object

Public Property Set GetForm(ByVal vNewValue As Object)
    Set oUForm = vNewValue
End Property

Private Sub PicturePart_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    initialX = x: initialY = y
    PicturePart.ZOrder 0
End Sub

Private Sub PicturePart_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim oCtrl As Control
    Static oPrevCtrl As Control

    If Button = 1 Then
        With PicturePart
            .Move .Left + (x - initialX), .Top + (y - initialY)
            For Each oCtrl In oUForm.Controls
                If TypeName(oCtrl) = "TextBox" Then
                    If Not oPrevCtrl Is Nothing Then
                        oPrevCtrl.Enabled = False
                        oPrevCtrl.BackStyle = fmBackStyleTransparent
                        oPrevCtrl.SpecialEffect = fmSpecialEffectEtched
                    End If
                    If .Left + .Width / 2 > oCtrl.Left And .Left + .Width / 2 < oCtrl.Left + oCtrl.Width _
                    And .Top + .Height / 2 > oCtrl.Top And .Top + .Height / 2 < oCtrl.Top + oCtrl.Height Then
                        oCtrl.Enabled = True
                        oCtrl.BackStyle = fmBackStyleOpaque
                        oCtrl.SpecialEffect = 6
                        oCtrl.BackColor = vbWhite
                        Set oPrevCtrl = oCtrl
                        Exit For
                    End If
                End If
            Next
        End With
    End If
End Sub

Private Sub PicturePart_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim oCtrl As Control
    
    For Each oCtrl In oUForm.Controls
        If TypeName(oCtrl) = "TextBox" Then
            With PicturePart
                If .Left + .Width / 2 > oCtrl.Left And .Left + .Width / 2 < oCtrl.Left + oCtrl.Width _
                And .Top + .Height / 2 > oCtrl.Top And .Top + .Height / 2 < oCtrl.Top + oCtrl.Height Then
                    .Move oCtrl.Left, oCtrl.Top
                    PicturePart.BorderStyle = fmBorderStyleNone
                    Call oUForm.FlashImagePart(PicturePart, oCtrl)
                    If InStr(1, PicturePart.Tag, oCtrl.Name) Then
                        PicturePart.Tag = PicturePart.Tag & "Success"
                    Else
                    If Right(PicturePart.Tag, 7) = "Success" Then
                            PicturePart.Tag = Mid(PicturePart.Tag, 1, Len(PicturePart.Tag) - 7)
                        End If
                    End If
                    Call oUForm.MsgbBeep
                    Call oUForm.CheckIfSuccess
                    Exit For
                End If
            End With
        End If
    Next
End Sub 

Problems are
When I compile the code the UserForm gives compile error 'Invalid use of property' on the following line

CODE -->

Set DestCtrl.Picture = IPic 
And i get Runtime Error 13 Type Mismatch on the following line

CODE -->

CropPic lImgPartWidth, lImgPartHeight, lImgPartLeft, lImgPartTop, Me.Controls("image" & iArray(lControlCounter)) 

I'm not sure what else might be wrong with the code because I can't get past these errors.

I have attached a small sample db which may help simplify things, or not.

Any help would be much appreciated.

RE: Compile error Invalid use of property and Runtime Error 13 Type Mismatch

(OP)
Managed to get it going

RE: Compile error Invalid use of property and Runtime Error 13 Type Mismatch

Firstly try changing

Private Sub CropPic(ByVal nWidth, ByVal nHeight, ByVal x, ByVal y, DestCtrl As Image)

to

Private Sub CropPic(ByVal nWidth As Long, ByVal nHeight As Long, ByVal x As Long, ByVal y As Long, DestCtrl As Object)

(mind you, I think you'll then encounter some additional errors)

RE: Compile error Invalid use of property and Runtime Error 13 Type Mismatch

Some objects declared "As Something" duplicate in access (the host application) and MSForms (application) libraries. As acces library has higher priority, vba tries to use access library for MSForms controls, this generates multiple "Type mismatch" errors. Try percise declarations, both for variables and function arguments, for instance "As MSForms.Image", "As MSForms.Control" etc.

combo

RE: Compile error Invalid use of property and Runtime Error 13 Type Mismatch

combo's answer is better.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close