Images not switching with printing loop

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,879
Office Version
  1. 2016
Platform
  1. Windows
Hello again,

I am yet into another trouble and I want someone pull me out:

My image control is not switching its images when I use the loop to print. It maintains only the first image throughout .

So if the first item has no image, then it takes that for all the others.

Meanwhile when I select the items one by one from the listbox on the userform , it switches the images.

I have tried to enable screen updating and events. Also set the calculations to automatic yet it's not cool.

What is going wrong?

Code:
Private Sub CmdPrintAll ()
Dim i As Long 
With Sheet1
For i = 1 To 25
       . [G4] = i
        . [E3] = Application.VLookup (. [G4], Sheet2. [B2:F202], 2, False )
  . [E7] = Application.VLookup (. [G4], Sheet2. [B2:F202], 3, False )
Next i 
End With 
End Sub 


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target = Me.[E3] Or Target = Me.[E7] Then
        Select Case Target.Address
            Case Is = "$E$3"
                LoadIm "Image1", Me.[E3], [COLOR=#0000ff]"Passport"[/COLOR]
            Case Is = "$E$7"
                LoadIm "Image2", Me.[E7], [COLOR=#0000ff]"Signature[/COLOR]"
        End Select
    End If
End Sub




Sub LoadIm(cname$, r As Range, [COLOR=#0000ff]folder As String[/COLOR])
    Dim fpath$, sfile$
    fpath = ThisWorkbook.Path &[COLOR=#0000ff] "\" & folder[/COLOR]
    sfile = Dir(fpath & "\" & r.Text & ".*")
    If sfile <> vbNullString Then
        Me.OLEObjects(cname).Object.Picture = LoadPicture(fpath & "\" & sfile)
    Else
        Me.OLEObjects(cname).Object.Picture = LoadPicture("")
    End If
    If Err.Number = 53 Then Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End Sub
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Try with this

Code:
Sub LoadIm(cname$, r As Range, folder As String)
    Dim fpath$, sfile$
    
[COLOR=#0000ff]    DoEvents[/COLOR]
    
    fpath = ThisWorkbook.Path & "\" & folder
    sfile = Dir(fpath & "\" & r.Text & ".*")
[COLOR=#0000ff]    Me.OLEObjects(cname).Object.Picture = LoadPicture("")[/COLOR]
    If sfile <> vbNullString Then
        Me.OLEObjects(cname).Object.Picture = LoadPicture(fpath & "\" & sfile)
    Else
    End If
    If Err.Number = 53 Then Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End Sub
 
Last edited:

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,879
Office Version
  1. 2016
Platform
  1. Windows
Try with this

Code:
Sub LoadIm(cname$, r As Range, folder As String)
    Dim fpath$, sfile$
    
[COLOR=#0000ff]    DoEvents[/COLOR]
    
    fpath = ThisWorkbook.Path & "\" & folder
    sfile = Dir(fpath & "\" & r.Text & ".*")
[COLOR=#0000ff]    Me.OLEObjects(cname).Object.Picture = LoadPicture("")[/COLOR]
    If sfile <> vbNullString Then
        Me.OLEObjects(cname).Object.Picture = LoadPicture(fpath & "\" & sfile)
    Else
    End If
    If Err.Number = 53 Then Me.OLEObjects(cname).Object.Picture = LoadPicture("")
End Sub


Great workout! !!!


It's working.

The only issue is that the first two images are still the same.

It starts the switch from the third item
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Great workout! !!!
It's working.

The only issue is that the first two images are still the same.

It starts the switch from the third item

check that the files exist
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,964
Messages
5,599,071
Members
414,281
Latest member
Engjamal2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top