I know someone addressed this before, but I can't find it.
I'm inserting pictures based on cell contents. The code works great but
produces a lot of flickering. here is the code:
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
With wks
Select Case LCase(.Name)
Case Is = "cover"
'do nothing
Case Else
.Select

.Range("A2:D18").Select
If .Range("B25") < "" Then
.Unprotect
sName = .Range("A46").Text
.Pictures.Insert(sName).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 216#
Selection.ShapeRange.Width = 288#
Selection.ShapeRange.Rotation = 0#
.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
Else
End If
Range("E2:H2").Select
If .Range("E25") < "" Then
.Unprotect
sName = .Range("A47").Text
.Pictures.Insert(sName).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 216#
Selection.ShapeRange.Width = 288#
Selection.ShapeRange.Rotation = 0#
.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
Else
End If
Range("I2:L18").Select
If .Range("H25") < "" Then
.Unprotect
sName = .Range("A48").Text
.Pictures.Insert(sName).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 216#
Selection.ShapeRange.Width = 288#
Selection.ShapeRange.Rotation = 0#
.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
Else
End If
End Select
End With
Next wks
Can some help

Thanks,
--
CY