Forwarded from Group - Soft IT168 π
β€1
Media is too big
VIEW IN TELEGRAM
ααααΉαα’αααΈααΆααα·αααααΆαα Coreldraw has found multiple Auto-Backup fileβ2024
αααααΆαααααααααΌαααΆαααΆαααααΆαααααΉαααΆα ααα
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
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
ααΆαααααΆαααααααΌααααααα’α α’α¦ ααΆααααα
ααΈααα
This media is not supported in your browser
VIEW IN TELEGRAM
ααΌαααααα α’α α’α¦ ααΎαα·α α’α§ αααααΆαααα ααα»αααααααα»αααΆαα
αΆααα’αΆααααααααΆ ααΆααΎααααα½αααααΆαααΆαα»α
' 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
Media is too big
VIEW IN TELEGRAM
ααααααΆαα Curve α’αααα
Bitmap or Group File αααα»ααααααα·ααΈ ααΌαααααα π§
ααΆαααααΆαααΌαααΈααα
ααΆαααααΆαααΌαααΈααα
αααααΆα 13 αααα½ααααααΆαααΈα αααΆαπβ€οΈ
1/ https://pixabay.com/
2/ https://unsplash.com/
3/ https://www.pexels.com/
4/ https://freedesignresources.net/
5/ https://www.pngegg.com/
6/ https://lordicon.com/
7/ https://www.vectorstock.com/
8/ https://pikwizard.com/
9/ https://pngtree.com/
10/ https://www.iconfinder.com/
11/ https://www.freeimages.com/psd?ref=365psd
12/ https://icons8.com/icons/set/popular--animated
13/ https://www.freepik.com/
1/ https://pixabay.com/
2/ https://unsplash.com/
3/ https://www.pexels.com/
4/ https://freedesignresources.net/
5/ https://www.pngegg.com/
6/ https://lordicon.com/
7/ https://www.vectorstock.com/
8/ https://pikwizard.com/
9/ https://pngtree.com/
10/ https://www.iconfinder.com/
11/ https://www.freeimages.com/psd?ref=365psd
12/ https://icons8.com/icons/set/popular--animated
13/ https://www.freepik.com/
Pixabay
6.2 million+ Stunning Free Images to Use Anywhere - Pixabay
Find your perfect royalty-free image or video to download and use. β Royalty-free β No attribution required β High quality images.
β€1
α
αααα»ααα»αα’ααααΆα
ααααΌαααααΎααΆααααπ§ Coreldraw 2026 V27