troubleshooting Question

userform using vbmodeless not able to use arrow keys on sheet

Avatar of Fordraiders
FordraidersFlag for United States of America asked on
Microsoft Excel
10 Comments1 Solution456 ViewsLast Modified:
vba. excel 2010.

I have a userform that i'am calling and setting to :

showmodal = false

I'am doing some activity on Column O on the worksheet:
As i go from cell to cell i bringing up  a useform showing an image.
as i  go from cell to cell the image changes based on the value in the cell..

All this is working except that:
I cant use the arrow keys on the sheet i have to use the mouse..and click the cell.


on worksheet_selectionchange:

i have the code...

Dim targ2 As Range
If ActiveCell.Column = 17 Then 'Column O
 'Is in column O
' looking for manual entry  01-06-2006 column O only
   Dim Result2 As String
   Set targ2 = Intersect(Target, [Q:Q])
   If Not targ2 Is Nothing Then
     If targ2.Value <> "" Then

             'we are in the entry column
             ' WHERE DID I COME FROM
           MyPic = targ2
           UserForm2.Show vbModeless
           End If
       End If
 'Is not in column O
End If

Open in new window

Userform code:
Option Explicit

Const MAX_ZOOM = 4    ' 400% original size
Const MIN_ZOOM = 0.2  ' 20%  original size
Private m_sngWidth As Single
Private m_sngHeight As Single
Private m_sngZoom As Single
Sub LoadImage(Name As String)
    If Dir(Name) <> "" Then
        With Image2
            .AutoSize = True
            .Picture = LoadPicture(Name)
            m_sngHeight = .Height
            m_sngWidth = .Width
            .AutoSize = False
            .PictureSizeMode = fmPictureSizeModeStretch
            m_sngZoom = 1
            .Left = 1
            .Top = 1
        End With
        SetZoom m_sngZoom
        MsgBox "Unable to load image " & Chr(10) & Name, vbExclamation
    End If
End Sub

Sub SetZoom(Zoom As Single)

    With Image2
        .Width = m_sngWidth * Zoom
        .Height = m_sngHeight * Zoom
    End With
    Label1.Caption = "Zoom " & Format(Zoom, "0%")
    With Frame1
        .ScrollHeight = Image2.Height + 2
        .ScrollWidth = Image2.Width + 2
    End With

End Sub

Private Sub CommandButton1_Click()

    m_sngZoom = m_sngZoom + 0.1
    If m_sngZoom > MAX_ZOOM Then m_sngZoom = MAX_ZOOM
    CommandButton1.Enabled = m_sngZoom <> MAX_ZOOM
    CommandButton2.Enabled = m_sngZoom <> MIN_ZOOM
    SetZoom m_sngZoom
End Sub

Private Sub CommandButton2_Click()
    m_sngZoom = m_sngZoom - 0.1
    If m_sngZoom < MIN_ZOOM Then m_sngZoom = MIN_ZOOM
    CommandButton2.Enabled = m_sngZoom <> MIN_ZOOM
    CommandButton1.Enabled = m_sngZoom <> MAX_ZOOM
    SetZoom m_sngZoom

End Sub

Private Sub CommandButton3_Click()


Unload UserForm2
Application.Cursor = xlNormal

'Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Activate()
Dim i As Integer
Dim Gsku As String
Dim fPath As String
Dim GskuL As String
Dim fPathNF As String
Dim Gstart As String
Dim gJpg As String
     'selects the range to look for a name.  You have to have a range
    GskuL = MyPic
    Gsku = MyPic
'    Gsku = frmResultAll.ListBox1.Column(1)
'    GskuL = frmResultAll.ListBox1.Column(1)
    Gstart = Left(GskuL, 1)
    Gstart = Gstart
         Select Case Gstart
        Case 1
        gJpg = "C:\Ggw_Images_2013\1_JPG\"
        Case 2
        gJpg = "C:\Ggw_Images_2013\2_JPG\"
        Case 3
        gJpg = "C:\Ggw_Images_2013\3_JPG\"
        Case 4
        gJpg = "C:\Ggw_Images_2013\4_JPG\"
        Case 5
        gJpg = "C:\Ggw_Images_2013\5_JPG\"
        Case 6
        gJpg = "C:\Ggw_Images_2013\6_JPG\"
        Case 7
        gJpg = "C:\Ggw_Images_2013\7_JPG\"
        Case 8
        gJpg = "C:\Ggw_Images_2013\8_JPG\"
        Case 9
        gJpg = "C:\Ggw_Images_2013\9_JPG\"
        Case Else
        End Select
     'selects the range to look for a name.  You have to have a range
        On Error Resume Next
        If Gsku = "" Then
            fPathNF = "C:\Ggw_Images_2013\"
            UserForm2.Image2.Picture = LoadPicture(fPathNF & "NOTAVAIL.JPG")
                'Look in the directory where this workbook is located.
                               fPath = gJpg
              '  On Error Resume Next
                 'If a matching picture is found then display it.
      LoadImage (fPath & Gsku & ".jpg")
                'If No picture found then display the default picture.
                If Err = 0 Then Exit Sub
               fPathNF = "C:\Ggw_Images_2013\"
            Image2.Picture = LoadPicture(fPathNF & "NOTAVAIL.JPG")

        End If

End Sub

Private Sub UserForm_Initialize()
    Image2.BorderStyle = fmBorderStyleNone
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Unload UserForm2
Application.Cursor = xlNormal
Application.ScreenUpdating = True

End Sub

Private Sub UserForm_Terminate()

Unload UserForm2
Application.Cursor = xlNormal

Application.ScreenUpdating = True

End Sub

Open in new window

Join our community to see this answer!
Unlock 1 Answer and 10 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 10 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros