# Solution to slow performance of VBA with linked pictures



## tribulusterrestris (Mar 19, 2015)

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]


```
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:

```
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:

```
refreshCamPic (Sheets("sheetName").Pictures("Picture 62"))
```


What your thoughts?


----------



## tribulusterrestris (Mar 20, 2015)

Update to work also with pictures inside a group

Procedure:

```
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:

```
refreshCamPic (Sheets("sheetName").Pictures("Picture 62"))   'Ungrouped Picture
refreshCamPic (Sheets("sheetName").Shapes("Group 21").GroupItems("Picture 62")) 'Grouped on Group 21
```


----------

