changing activesheet shapes label caption
 

Hi All,
I have following code but it doess not work.Basically I try to change
the captions in a loop.Any help?
Thank you very much in advance
baha
sub givingnames
Dim i As Variant
Dim a As Variant
a = Sheet4.Range("AT39").Value

For i = 1 To 10
On Error Resume Next
ActiveSheet.Shapes("Image" & i).OLEFormat.Object.Object.Picture = _
LoadPicture(ThisWorkbook.Path & "\Pictures\" & a & ".BMP")
ActiveSheet.Shapes("LabelA" & i).Caption =
Application.WorksheetFunction.VLookup((a),
Sheets("DataPage").Range("dataA"), 2, 0) ' & _
'vbCrLf & "TempCard: " & Application.WorksheetFunction.VLookup(i + k +
alt - 1, Sheets("DataPage").Range("dataA"), 4, 0)

a = a + 1
If Dir(ThisWorkbook.Path & "\Pictures\" & i & ".BMP") = "" Then
ActiveSheet.Shapes("Image" & i).OLEFormat.Object.Object.Picture = _
LoadPicture(ThisWorkbook.Path & "\Pictures\nopic.BMP")
End If
Next i
end sub

changing activesheet shapes label caption
 

Sub CaptionShapes()

'Changes the Captiosn on all shapes on all Worksheets

Dim Wks As Worksheet
Dim myshape As Shape

For Each Wks In Worksheets
With Wks
'Loop through the Shapes collection
For Each myshape In ActiveSheet.Shapes
myshape.Select
With Selection
.Characters.Text = "Caption Text"
End With
Next myshape
End With
Next Wks
End Sub