KHTMFile 💾

' Place this at the top of the module to store the curve in memory
Public GlobalCurve As Shape

Sub SmartCurvePaste()
    Dim sld As ShapeRange
    Dim target As Shape, sNew As Shape
    
    ' Get the current selection
    Set sld = ActiveSelectionRange

    ' STEP 1: If only 1 object is selected, treat it as the Master Curve to be copied
    If sld.Count = 1 Then
        Set GlobalCurve = sld.Shapes(1)
        MsgBox "Curve stored in memory! Now select your target Bitmaps or Groups and run this macro again.", vbInformation
        Exit Sub
    End If

    ' STEP 2: If multiple objects are selected, perform the paste and align logic
    If GlobalCurve Is Nothing Then
        MsgBox "Please select a single Master Curve first to store it!", vbExclamation
        Exit Sub
    End If

    ' Optimization: Disable screen refresh for faster execution
    Optimization = True
    
    For Each target In sld
        ' Avoid duplicating the Master Curve onto itself if it's part of the selection
        If target.StaticID <> GlobalCurve.StaticID Then
            ' Create a duplicate of the stored curve
            Set sNew = GlobalCurve.Duplicate
            
            ' C and E: Align to the exact center of the target (Works for Groups too)
            sNew.CenterX = target.CenterX
            sNew.CenterY = target.CenterY
            
            ' Match Rotation: Matches the target's angle (e.g., 0.5°, 45°, or 90°)
            sNew.RotationAngle = target.RotationAngle
            
            ' Move to the front of the stacking order
            sNew.OrderToFront
        End If
    Next target

    ' Re-enable optimization and force an immediate screen redraw
    Optimization = False
    ActiveWindow.Refresh
    Application.Refresh
End Sub

Sub FastPasteCE_AutoRotate()
    ' Disable screen updates to increase execution speed
    Optimization = True
    
    Dim sCurve As Shape, sBmp As Shape, sNew As Shape
    Dim isCurveHorizontal As Boolean
    
    ' Check if at least two objects are selected
    If ActiveSelection.Shapes.Count < 2 Then 
        MsgBox "Please select one Curve first, then select your Bitmaps!"
        Optimization = False
        Exit Sub
    End If

    ' Set the first selected object as the Master Curve
    Set sCurve = ActiveSelection.Shapes(1)
    
    ' Determine if the Master Curve is Horizontal or Vertical
    isCurveHorizontal = (sCurve.SizeWidth > sCurve.SizeHeight)
    
    For Each sBmp In ActiveSelection.Shapes
        ' Avoid duplicating the master curve onto itself
        If sBmp.StaticID <> sCurve.StaticID Then
            Set sNew = sCurve.Duplicate
            
            ' Check Bitmap orientation: If it differs from the Curve, rotate 90 degrees
            If (sBmp.SizeWidth > sBmp.SizeHeight) <> isCurveHorizontal Then
                sNew.Rotate 90
            End If
            
            ' C and E: Align center horizontally and vertically
            sNew.CenterX = sBmp.CenterX
            sNew.CenterY = sBmp.CenterY
            
            ' Bring the new curve to the front layer
            sNew.OrderToFront
        End If
    Next sBmp
    
    ' Re-enable optimization and refresh the screen immediately
    Optimization = False
    ActiveWindow.Refresh
    Application.Refresh ' <--- This is the command you asked for
End Sub

Sub FastPasteCE_Optimized()
    ' បិទការ Refresh អេក្រង់ជាបណ្តោះអាសន្នដើម្បីឱ្យកូដរត់លឿនជាងមុន
    Optimization = True
    
    Dim sCurve As Shape, sBmp As Shape, sNew As Shape
    
    If ActiveSelection.Shapes.Count < 2 Then 
        MsgBox "សូមជ្រើសរើស Curve មួយ និង Bitmap ផ្សេងៗទៀត!"
        Exit Sub
    End If

    Set sCurve = ActiveSelection.Shapes(1)
    
    For Each sBmp In ActiveSelection.Shapes
        If sBmp.StaticID <> sCurve.StaticID Then
            Set sNew = sCurve.Duplicate
            ' C និង E (Center alignment)
            sNew.CenterX = sBmp.CenterX
            sNew.CenterY = sBmp.CenterY
            sNew.OrderToFront
        End If
    Next sBmp
    
    ' បើកការ Refresh វិញនៅពេលចប់ការងារ
    Optimization = False
    ActiveWindow.Refresh
End Sub