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
Else
'Is not in column O
End If
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
Else
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()
'WhichForm
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")
Else
'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
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
”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.
Our community of experts have been thoroughly vetted for their expertise and industry experience.
The Most Valuable Expert award recognizes technology experts who passionately share their knowledge with the community, demonstrate the core values of this platform, and go the extra mile in all aspects of their contributions. This award is based off of nominations by EE users and experts. Multiple MVEs may be awarded each year.
The Distinguished Expert awards are presented to the top veteran and rookie experts to earn the most points in the top 50 topics.