Export every selection into JPEG at Desktop Area without asking any name, please kindly update this below macro

Sub ExportSelectedObjectToJPEG()
On Error GoTo ErrHandler

Dim selectedObject As shape
Dim exportResolution As Integer
Dim exportFileName As String
Dim tempPage As page
Dim tempShape As shape

' Check for selected object
If ActiveSelection.shapes.Count = 0 Then
MsgBox "No object is selected. Please select an object to export.", vbExclamation
Exit Sub
End If
Set selectedObject = ActiveSelection.shapes(1)

' Prompt for export resolution
exportResolution = InputBox("Enter export resolution (DPI):", "Export Resolution", 300)
If exportResolution = 0 Then Exit Sub ' Exit if export resolution is 0 or canceled

' Set export file name
exportFileName = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\ExportedImage.jpg"

' Create a temporary page
Set tempPage = ActiveDocument.Pages.Add

' Copy the selected object to the temporary page
Set tempShape = tempPage.shapes.AddClone(selectedObject)

' Export the temporary page to JPEG
tempPage.ExportBitmap exportFileName, cdrJPEG, cdrRGBColorImage, cdrRasterImage, cdrAntiAliasingTypeNone, cdrCompressionNone, exportResolution, exportResolution

' Delete the temporary page
tempPage.Delete

MsgBox "Object exported successfully to " & exportFileName, vbInformation

Exit Sub

ErrHandler:
MsgBox "An error occurred: " & Err.Description, vbCritical
End Sub