Updating ActiveX Image Control While Running A Macro

[macohen]

I'm sorry if my explanation isn't super clear, I'm not sure how to explain this too well.

I have an excel database (Parameters) that contains around 250 entries. On a seperate worksheet, I have a form (TSC Datacard) that populates with data depending on the form number I choose. For ex: Form X populates with data from row X in my database worksheet. One of the main features of this form is 3 activex image controls at the bottom that show 3 different pictures relating to the form's information. These images update whenever the form number selected changes.

Now, I added in a button that cycles through all ~250 entries one by one and exports them to PDF for easy access for my employees. My issue is, when I run the export code, the activex images do not update with the datacards. Therefore every PDF exported has the images for Card 1 and not for their respective numbers.
I have posted my two blocks of code below, one that calls the images and inserts them into the activex image controls, and the other that runs when a button is clicked to export all the cards to PDF. I was wondering if there was a way to merge the two blocks so as to have the images update while being exported to PDF.
Thanks

Code that updates the ActiveX Image Control

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WS As Worksheet
Dim mPath As String
Dim mPath2 As String
Dim mPath3 As String
Dim mPath4 As String

mPath4 = "G:\Dept624504\3000_Ingenierie\07.ProcessesInfo\Thermal Spray coating\Pictures_booth1\blank.jpg"



'Box 1

If Not Application.Intersect(Range("$A$1:$AA$68"), Target) Is Nothing Then
    mPath = "G:\Dept624504\3000_Ingenierie\07.ProcessesInfo\Thermal Spray coating\Pictures_booth1\" & Replace(Range("$C$6").Text, "/", "-") & "-BOOTH-1" & ".jpg"

If Dir(mPath) <> "" Then
      Set WS = ActiveSheet
    WS.OLEObjects("Image1").Object.Picture = LoadPicture(mPath)
    Else
Set WS = ActiveSheet
    WS.OLEObjects("Image1").Object.Picture = LoadPicture(mPath4)
End If
End If

'Box 2

If Not Application.Intersect(Range("$A$1:$AA$68"), Target) Is Nothing Then
   mPath2 = "G:\Dept624504\3000_Ingenierie\07.ProcessesInfo\Thermal Spray coating\Pictures_booth2\" & Replace(Range("$C$6").Text, "/", "-") & "-BOOTH-2" & ".jpg"
If Dir(mPath2) <> "" Then
      Set WS = ActiveSheet
    WS.OLEObjects("Image2").Object.Picture = LoadPicture(mPath2)
Else
Set WS = ActiveSheet
    WS.OLEObjects("Image2").Object.Picture = LoadPicture(mPath4)
End If
End If

'Box 3

If Not Application.Intersect(Range("$A$1:$AA$68"), Target) Is Nothing Then
    mPath3 = "G:\Dept624504\3000_Ingenierie\07.ProcessesInfo\Thermal Spray coating\Pictures_booth3\" & Replace(Range("$C$6").Text, "/", "-") & "-BOOTH-3" & ".jpg"
 If Dir(mPath3) <> "" Then
    Set WS = ActiveSheet
    WS.OLEObjects("Image3").Object.Picture = LoadPicture(mPath3)
   Else
    Set WS = ActiveSheet
    WS.OLEObjects("Image3").Object.Picture = LoadPicture(mPath4)
    End If
End If
End Sub

Code That Exports All To PDF

Sub ExportAllAsPDF()

'Suppress PDF error messages
On Error Resume Next

'Declare variables
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
Dim DataCardReferenceNumber As Integer
Dim DataCardCounter As Integer
Dim PDFFileName As String
Dim PDFSaveLocation As String

'Count up how many datcards we have

'Select the first datacard in the Parameters
Application.ScreenUpdating = True
Sheets("Parameters").Select
Range("CL1").Select

'Initialise the counter
DataCardCounter = 1

'Loop through the Parameters until we find an empty cell
Do
    ActiveCell.Offset(1, 0).Select
    DataCardCounter = DataCardCounter + 1
Loop Until IsEmpty(ActiveCell.Offset(1, 0))

'Record the number of datacards
NumberOfDataCards = DataCardCounter

'Go back to the datacard sheet
Sheets("Parameters").Select
Application.ScreenUpdating = True

'Warn the user they are about to create lots of PDFs
strPrompt = "You are about to export datacards. If you have selected lots, this may overwrite existing data cards and may take some time. Continue?"
strTitle = "Warning!"
iRet = MsgBox(strPrompt, vbYesNo, strTitle)

'Stop the macro if they say no
If iRet = vbNo Then
    End

'Otherwise, generate the PDFs
Else
    Application.ScreenUpdating = True

    'Set up the loop
    For DataCardCounter = 1 To NumberOfDataCards

    'Find the datacard reference number
    Sheets("Parameters").Select
    Range("CL1").Offset(DataCardCounter).Select
    DataCardReferenceNumber = ActiveCell.Value

    'Set U2 to the datacard number for export. The fields will fill themselves out according to this number
    Sheets("TSC Datacard").Select
    Application.ScreenUpdating = True
    Range("W7").Select
    ActiveCell.Value = DataCardReferenceNumber

    'Check if the active datacard has been selected for export
    Range("Z2").Select

    'If it has, then go ahead with the export. Otherwise skip the datcard
    If ActiveCell.Value = "YES" Then

        'Get the PDF file name and location as specified by the user
        If Sheets("TSC Datacard").Range("S4") = "YES" Then

                    PDFFileName = Range("W5").Value & " - CONTROLLED"

                Else

         PDFFileName = Range("W5").Value

                    End If

        PDFSaveLocation = Range("V17").Value

        'Create the progress message
        Application.StatusBar = "Exporting datacard " & DataCardReferenceNumber & " as " & PDFSaveLocation & PDFFileName & ".pdf (Hold ESC to interrupt)"


        'Export as PDF
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            PDFSaveLocation & PDFFileName & ".pdf", Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False

    Else

        'Create the progress message
        Application.StatusBar = "Skipping datacard " & DataCardReferenceNumber & "..."

    End If

    'Go to the next datacard
    Next DataCardCounter



    'Clear the cell containing the datacard number to be exported
    Range("U2").ClearContents

End If

' Reset all messages
Range("U2").ClearContents
Application.ScreenUpdating = True
Application.StatusBar = False

End Sub