Dynamic pictures with UserForms - operation too slow sometimes

[gravanoc]

I've got a userform that is populated with some checkboxes and image controls displaying a section of a worksheet. It is successful probably about 85% of the time. The other times it just doesn't export the picture to the folder properly, and when it populates it looks blank or like an empty chart (since a chart is used in the process). If I run the code step by step instead of like normal it will always work, so something like the paste command is not consistently working. Here is the code involved:

Sub ExportAsPicture(Optional choice As String, Optional bAddImages As Boolean, Optional y As Long)

    Dim fso As Object, aFold As Object
    Dim aFile As Object
    Dim thePic As Picture
    Dim rngView(0 To 3) As Range
    Dim MyChart As String, MyPicture As String
    Dim PicWidth As Long, PicHeight As Long
    Dim fileName As String
    Dim filePath As String
    Dim i As Long, X As Long
    
    ' choice = wksDefinitions.Range("CF20")
    filePath = Environ("UserProfile") & "\OneDrive\Pictures\Budget Tool\"

    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set aFold = fso.GetFolder(filePath)
    
    If Err.Number <> 0 Then
        Set aFold = fso.CreateFolder(filePath)
    End If
    
    On Error GoTo 0
    
    If bAddImages = False Then
        wksDefinitions.Range("BY18").Offset(0, 0).Value = ""
        wksDefinitions.Range("BY18").Offset(0, 1).Value = ""
        wksDefinitions.Range("BY18").Offset(0, 2).Value = ""
        wksDefinitions.Range("BY18").Offset(0, 3).Value = ""
        X = 3
    Else
        X = 0
    End If

    Application.ScreenUpdating = False
    wksDashboard.Activate
    For i = 0 To X
        Set rngView(i) = wksDashboard.Range("View" & i + 1)
        If InStr(1, LCase(choice), "view " & (i + y) + 1) Then
            
            DoEvents
            rngView(i).CopyPicture Appearance:=xlScreen, format:=1
            ActiveSheet.Paste
            Set thePic = Selection
            fileName = Replace(Replace(Replace(Replace(Now, ":", ""), "/", ""), " ", ""), "PM", "") & (i + y)
            
            MyPicture = Selection.Name
            With Selection
                  PicHeight = .ShapeRange.Height
                  PicWidth = .ShapeRange.Width
            End With
        
            wksDashboard.Shapes.AddChart2(201, xlColumnClustered).Select
            ActiveChart.Location Where:=xlLocationAsObject, Name:="Dashboard"
            Selection.Border.LineStyle = 0
            MyChart = Selection.Name
        
            With wksDashboard
                  With .Shapes(MyChart)
                        .Width = PicWidth
                        .Height = PicHeight
                  End With
        
                  .Shapes(MyPicture).Copy
        
                  With ActiveChart
                        .ChartArea.Select
                        .Paste
                  End With

                  .ChartObjects(1).Chart.Export fileName:=filePath & fileName & ".jpg", FilterName:="jpg"
                  .Shapes(MyChart).Delete
            End With
            thePic.Delete
            wksDefinitions.Range("Attachments").Offset(0, i).Value = "\Pictures\Budget Tool\" & fileName & ".jpg"
        End If
    Next i
    wksTracker.Activate
    Application.ScreenUpdating = True
    Exit Sub

Finish:

End Sub

This is how it should look:

This is how it looks sometimes:

 

[Jaafar Tribak]

Do you need to save the image files to disk ? Are you importing the save image files when loading the userform ? I wouldn't use the chart object Export method for this when using it repetitively inside a loop and expect it to be fast. Better not to save the image file to disk at all.

I would copy the image of the range(s) , query the clipboard for the CF_ENHMETAFILE format using GetClipboardData and then use OleCreatePictureIndirect to obtain a StdPicture object from the clipboard image pointer. Once you obtain the StdPic object, you just assign it to the Picture Property of your userform image controls... No file saving to disk will be involved at all.

This would be much quicker but you will probably need to change the overall design of your code.

Do a search for OleCreatePictureIndirect and GetClipboardData. There are many examples online and in this message board.

 

[gravanoc]

Thanks! Well, I did end up just copying a range to a new workbook. I had been copying the area as picture & then doing that process. I used some static pictures instead for the controls. Thank you for your advice on this though, as I'm sure I'll need to use something similar again in the future.