Onde estou errando nesse código.

Estou tentando exportar todos os objetos selecionados em pdf. 

=======================================

Sub exportar_selecionado()
Dim sr As ShapeRange, sel As ShapeRange
Dim s As Shape
Dim expflt As ExportFilter
Dim pth$, imgpath$, sh_name$, dname$, pname$

imgpath = "C:\temp\"

'imgpath = form_export.folder_TextBox.Text
'If Right$(imgpath, 1) <> "\" Then imgpath = imgpath & "\"

If imgpath = "" Then pth = ActiveDocument.FilePath Else: pth = imgpath

Set sr = ActiveSelectionRange

For Each s In sr.Shapes
s.CreateSelection
sh_name = s.ObjectData("Name").FormattedValue
sh_id = s.StaticID
Set expflt = ActiveDocument.ExportBitmap(pth & sh_name & sh_id & ".pdf", cdrPDF, cdrSelection, cdrRGBColorImage)
expflt.Finish
Next s

End Sub

==========================================================

O problema que ele está aparecendo uma mensagem

No final de tudo ele acaba exportando somente o primeiro objeto.

Se  alguém conseguir me ajudar agradeço.