Public Sub StickerExportAll()
Dim p As Page, Start
sn = 1
For Each p In ActiveDocument.Pages
p.Activate
Dim sName As String
sName = ActiveDocument.Name
If Right$(sName, 4) = ".cdr" Then sName = Left$(sName, Len(sName) - 4)
sName = sn & "-" & sName
ActiveWindow.ActiveView.ToFitPage

Dim expflt As ExportFilter
Dim expopt As StructExportOptions
Set expopt = New StructExportOptions
Dim d1 As Document
Set expflt = Nothing
Set d1 = ActiveDocument
Dim sx As Double, sy As Double

ActiveLayer.Shapes.All.GetSize sx, sy
Set expflt = d1.ExportEx(Environ("USERPROFILE") & "\Desktop\KH-EPS\" & sName & ".eps", cdrEPS, cdrCurrentPage, expopt)

With expflt
.Header = 1 ' FilterEPSLib.epsTIFFHeader
.TIFFHeaderType = 4 ' FilterEPSLib.epsTIFFColor8
.Resolution = 150
.Transparent = True
.TextAsCurves = True
.IncludeFonts = False
.ApplyICCProfile = False
.SendBitmapsAs = 1 ' FilterEPSLib.epsRGB
.MaintainOPILinks = False
.AdjustFountainSteps = False
.FountainSteps = 255
.PSLevel = 3 ' FilterEPSLib.epsPSLevel3
.UserName = "Oates Flag"
.UseJPEGCompression = False
.JPEGCompression = 2
.PreserveOverprints = True
.OverprintBlack = False
.AutoSpread = False
.FixedWidth = False
.MaxSpread = 1.41732283464567E-04
.TextSpread = 5.10236220472441E-03
.BoundingBox = 0 ' FilterEPSLib.epsObjects
.UseBleed = False
.Bleed = 31750
.CropMarks = False
.UseFloatNumbers = False
.UseSeparationProfile = True
.ConvertSpot = False
.Finish
End With
Set expflt = Nothing
sn = sn + 1
Start = Timer
Do While Timer < Start + 2
Loop
Next p
End Sub

1 inch to mm = 25.4 mm

2 inch to mm = 50.8 mm

3 inch to mm = 76.2 mm

4 inch to mm = 101.6 mm

5 inch to mm = 127 mm

6 inch to mm = 152.4 mm

7 inch to mm = 177.8 mm

8 inch to mm = 203.2 mm

9 inch to mm = 228.6 mm

10 inch to mm = 254 mm

Sub UGACombine()
    ' Recorded 19-Aug-24
    Dim OrigSelection As ShapeRange
    Set OrigSelection = ActiveSelectionRange
    OrigSelection.ConvertToCurves
    Dim grp1 As ShapeRange
    Set grp1 = OrigSelection.UngroupAllEx
    Dim grp2 As ShapeRange
    Set grp2 = grp1.UngroupAllEx
    grp1.CreateSelection
    Dim s1 As Shape
    Set s1 = ActiveSelection.Combine
    Dim grp3 As ShapeRange
    Set grp3 = s1.UngroupAllEx
    grp3.CreateSelection
    Dim s2 As Shape
    Set s2 = ActiveSelection.Combine
    ' Recording of this command is not supported: StyleModify
    
End Sub