Solution to slow performance of VBA with linked pictures

tribulusterrestris

New Member
Joined
Mar 5, 2015
Messages
7
Hi, I recently solved an undercovered issue.
If your workbook has some picture created with Camera Tool the VBA performance slowdown enormously.

Bottom line is: as long as your picture is dynamic, vba will suffer when changing cells, because it scans all the workbook for changes that can affect the linked picture.

I found 2 approaches to solve:

1) Setup a named range to enable or disable the update (I failed making this work on my brazilian portuguese version of excel, with localized syntax)
Link: Daily Dose of Excel » Blog Archive » Performance of linked pictures

2) Disable the update when needed
Link: Camera tool is slowing macro [SOLVED]

Code:
Sub Test()
Dim S As String
S = Sheets(2).Pictures(1).Formula
Sheets(2).Pictures(1).Formula = ""
'your code here
Sheets(2).Pictures(1).Formula = S
End Sub

And then I came up with a third solution, inspired by #2
3) Force a refresh only when needed.
Formula is stored on AlternativeText attribute

Procedure:
Code:
Sub initCamPicShape(ByRef oCamPic As Object)                          'stores formula into alternativetext
    oCamPic.ShapeRange.AlternativeText = oCamPic.Formula    'need to be done just when create a new picture
    oCamPic.Formula = ""
End Sub

Sub refreshCamPic(ByRef oCamPic)
    If (oCamPic.ShapeRange.AlternativeText = "") Then
        initCamPicShape (oCamPic)
    Else
        oCamPic.Formula = Trim(oCamPic.ShapeRange.AlternativeText)
        DoEvents
        oCamPic.Formula = ""
    End If
End Sub

Use:
Code:
refreshCamPic (Sheets("sheetName").Pictures("Picture 62"))


What your thoughts?
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Update to work also with pictures inside a group

Procedure:
Code:
Sub initCamPicShape(ByRef oCamPic As Object)                          'armazena a formula no alternativetext
    Dim sAlternativeText As String
    If (TypeName(oCamPic) = "Picture") Then
        oCamPic.ShapeRange.AlternativeText = oCamPic.Formula    'so precisa ser feito uma vez, quando criado
    ElseIf (TypeName(oCamPic) = "Shape") Then
        oCamPic.AlternativeText = oCamPic.Formula    'so precisa ser feito uma vez, quando criado
    Else
        Debug.Print "TypeName não previsto: " & TypeName(oCamPic)
        Exit Sub
    End If
    oCamPic.Formula = ""
End Sub
Sub refreshCamPic(ByRef oCamPic)
    Dim sAlternativeText As String
    If (TypeName(oCamPic) = "Picture") Then
        sAlternativeText = oCamPic.ShapeRange.AlternativeText
        If (sAlternativeText = "") Then
            initCamPicShape (oCamPic)
        Else
            oCamPic.Formula = Trim(sAlternativeText)
            DoEvents
            oCamPic.Formula = ""
        End If
    ElseIf (TypeName(oCamPic) = "Shape") Then
        sAlternativeText = oCamPic.AlternativeText
        If (sAlternativeText = "") Then
            initCamPicShape (oCamPic)
        Else
            oCamPic.OLEFormat.Object.Formula = Trim(sAlternativeText)
            DoEvents
            oCamPic.OLEFormat.Object.Formula = ""
        End If
    Else
        Debug.Print "TypeName não previsto: " & TypeName(oCamPic)
        Exit Sub
    End If
End Sub

Use:
Code:
refreshCamPic (Sheets("sheetName").Pictures("Picture 62"))   'Ungrouped Picture
refreshCamPic (Sheets("sheetName").Shapes("Group 21").GroupItems("Picture 62")) 'Grouped on Group 21
 
Upvote 0

Forum statistics

Threads
1,223,948
Messages
6,175,568
Members
452,652
Latest member
eduedu

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
Back
Top