JPGEXPKH.gms
39 KB
ααΆααα
ααααΎααααΆαααααααααΈπ§π§ ααΆ Okey αα»αααααα
ααΆα ααααααα»α
This media is not supported in your browser
VIEW IN TELEGRAM
Coreldraw Link Number Faster Excel top Coreldrawπππ
π1
Sub CopyCurveLengthToText()
Dim s As Shape
Dim t As Shape
Dim lengthVal As Double
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
OrigSelection.ConvertToCurves
' Check if there is an active selection
If ActiveShape Is Nothing Then
MsgBox "Please select a curve first!", vbExclamation
Exit Sub
End If
Set s = ActiveShape
' Check if the selected shape is a curve
If s.Type = cdrCurveShape Then
' Calculate curve length (VBA default is Inches, so multiply by 2.54 for cm)
lengthVal = s.Curve.Length * 2.54
' Create Artistic Text with 4 decimal places
Set t = ActiveLayer.CreateArtisticText(0, 0, "Length: " & Round(lengthVal, 4) & " cm")
' Align text to the center of the selection
t.CenterX = s.CenterX
' Position the text slightly above the curve
t.CenterY = s.CenterY + 1
' Set text color to Red for visibility
' t.Fill.UniformColor.SetRGB 255, 0, 0
Else
MsgBox "The selected object is not a curve.", vbCritical
End If
End Sub
αααα»αα±ααΆααα·ααΈαα»αααα
αΌαααααΆαααααΈαααααααΈααΆαα·ααααα
ααΆααααα»αααΆαααααααααΆα α ααα½α α₯ αααα
α αΆααααΈααααααΈα‘α’ ααα α‘α¦ ααααααΆ ααααΆαα’α α’α¦α
ααΉαα αΌααααααΎααΆαααΆαααΌαααααααΈα‘α§ ααααααΆ ααααΆαα’α α’α¦ ααΆααααααΆα
ααΎααααα»αααΌααααααα’αααα’ααα»ααααΆαααααΆααααα αααα’αα·αα·ααααΆααα’αα
αααααΆαααΆααααααΆαααΎααααα»αααααααα αα·αααααααΆααααααΆαα·α αα ααΆαα
ααΌαααΌαααα’αα·αα·ααααΆααα’ααα’αα ααααα½αααΆαααΆαααΆα αα·ααα½ααααα»ααααα α€αααααΆα α’αΆαα» αααα αα»α αα·α αα αααααΈααΆαααα»αααΎααααααααααααααααα
ααΎααααα»αααΌααααααΈα’ααααααα ααααααΆαααααΎααααααααΆαααΆαααΊααααΆαααααααα ααΌαα’αααααα αα·αα’ααα»ααα»αααΆαα»αα
ααΆααααα»αααΆαααααααααΆα α ααα½α α₯ αααα
α αΆααααΈααααααΈα‘α’ ααα α‘α¦ ααααααΆ ααααΆαα’α α’α¦α
ααΉαα αΌααααααΎααΆαααΆαααΌαααααααΈα‘α§ ααααααΆ ααααΆαα’α α’α¦ ααΆααααααΆα
ααΎααααα»αααΌααααααα’αααα’ααα»ααααΆαααααΆααααα αααα’αα·αα·ααααΆααα’αα
αααααΆαααΆααααααΆαααΎααααα»αααααααα αα·αααααααΆααααααΆαα·α αα ααΆαα
ααΌαααΌαααα’αα·αα·ααααΆααα’ααα’αα ααααα½αααΆαααΆαααΆα αα·ααα½ααααα»ααααα α€αααααΆα α’αΆαα» αααα αα»α αα·α αα αααααΈααΆαααα»αααΎααααααααααααααααα
ααΎααααα»αααΌααααααΈα’ααααααα ααααααΆαααααΎααααααααΆαααΆαααΊααααΆαααααααα ααΌαα’αααααα αα·αα’ααα»ααα»αααΆαα»αα
αααααΆααααΆαααΆααααα αΆααααααα
ActiveDocument.Rulers.HUnits
ActiveDocument.Unit
ActiveDocument.Rulers.HUnits
ActiveDocument.Unit
Sub RenamePagesFromTextBulk()
Dim doc As Document
Dim pg As Page
Dim shp As Shape
Dim txt As String
Dim i As Integer
Dim invalidChars As String
Dim regex As Object
If Documents.Count = 0 Then
MsgBox "ΠΠ΅Ρ ΠΎΡΠΊΡΡΡΠΎΠ³ΠΎ Π΄ΠΎΠΊΡΠΌΠ΅Π½ΡΠ°.", vbExclamation, "ΠΡΠΈΠ±ΠΊΠ°"
Exit Sub
End If
Set doc = ActiveDocument
invalidChars = "\/:*?""<>|"
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "[\/:*?""<>|]"
regex.Global = True
For Each pg In doc.Pages
txt = ""
' ΠΠ΅ΡΠ΅ΠΊΠ»ΡΡΠ°Π΅ΠΌΡΡ Π½Π° ΡΡΡΠ°Π½ΠΈΡΡ
pg.Activate
' ΠΡΠ΅ΠΌ ΠΏΠ΅ΡΠ²ΡΠΉ ΡΠ΅ΠΊΡΡΠΎΠ²ΡΠΉ ΠΎΠ±ΡΠ΅ΠΊΡ Π½Π° ΡΡΡΠ°Π½ΠΈΡΠ΅
For i = 1 To ActivePage.Shapes.Count
Set shp = ActivePage.Shapes(i)
If shp.Type = cdrTextShape Then
txt = shp.Text.Story.Text
Exit For
End If
Next i
txt = Trim(txt)
If Len(txt) = 0 Then
' Π½Π΅Ρ ΡΠ΅ΠΊΡΡΠ° β ΠΏΡΠΎΠΏΡΡΠΊΠ°Π΅ΠΌ ΡΡΡΠ°Π½ΠΈΡΡ
GoTo NextPage
End If
' Π½ΠΎΡΠΌΠ°Π»ΠΈΠ·Π°ΡΠΈΡ ΡΠ΅ΠΊΡΡΠ°
txt = Replace(txt, vbCrLf, " ")
txt = Replace(txt, vbCr, " ")
txt = Replace(txt, vbLf, " ")
txt = regex.Replace(txt, "")
txt = Trim(txt)
If Len(txt) > 31 Then txt = Left(txt, 31)
If Len(txt) = 0 Then GoTo NextPage
' Π·Π°ΡΠΈΡΠ° ΠΎΡ Π΄ΡΠ±Π»Π΅ΠΉ
txt = MakeUniquePageName(doc, txt)
On Error Resume Next
pg.Name = txt
On Error GoTo 0
NextPage:
Next pg
MsgBox "ΠΠ΅ΡΠ΅ΠΈΠΌΠ΅Π½ΠΎΠ²Π°Π½ΠΈΠ΅ ΡΡΡΠ°Π½ΠΈΡ Π·Π°Π²Π΅ΡΡΠ΅Π½ΠΎ.", vbInformation
End Sub
Function MakeUniquePageName(doc As Document, baseName As String) As String
Dim nameTry As String
Dim counter As Integer
Dim p As Page
Dim exists As Boolean
nameTry = baseName
counter = 1
Do
exists = False
For Each p In doc.Pages
If p.Name = nameTry Then
exists = True
Exit For
End If
Next p
If Not exists Then Exit Do
nameTry = baseName & "_" & counter
counter = counter + 1
Loop
MakeUniquePageName = nameTry
End Function
Dim doc As Document
Dim pg As Page
Dim shp As Shape
Dim txt As String
Dim i As Integer
Dim invalidChars As String
Dim regex As Object
If Documents.Count = 0 Then
MsgBox "ΠΠ΅Ρ ΠΎΡΠΊΡΡΡΠΎΠ³ΠΎ Π΄ΠΎΠΊΡΠΌΠ΅Π½ΡΠ°.", vbExclamation, "ΠΡΠΈΠ±ΠΊΠ°"
Exit Sub
End If
Set doc = ActiveDocument
invalidChars = "\/:*?""<>|"
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "[\/:*?""<>|]"
regex.Global = True
For Each pg In doc.Pages
txt = ""
' ΠΠ΅ΡΠ΅ΠΊΠ»ΡΡΠ°Π΅ΠΌΡΡ Π½Π° ΡΡΡΠ°Π½ΠΈΡΡ
pg.Activate
' ΠΡΠ΅ΠΌ ΠΏΠ΅ΡΠ²ΡΠΉ ΡΠ΅ΠΊΡΡΠΎΠ²ΡΠΉ ΠΎΠ±ΡΠ΅ΠΊΡ Π½Π° ΡΡΡΠ°Π½ΠΈΡΠ΅
For i = 1 To ActivePage.Shapes.Count
Set shp = ActivePage.Shapes(i)
If shp.Type = cdrTextShape Then
txt = shp.Text.Story.Text
Exit For
End If
Next i
txt = Trim(txt)
If Len(txt) = 0 Then
' Π½Π΅Ρ ΡΠ΅ΠΊΡΡΠ° β ΠΏΡΠΎΠΏΡΡΠΊΠ°Π΅ΠΌ ΡΡΡΠ°Π½ΠΈΡΡ
GoTo NextPage
End If
' Π½ΠΎΡΠΌΠ°Π»ΠΈΠ·Π°ΡΠΈΡ ΡΠ΅ΠΊΡΡΠ°
txt = Replace(txt, vbCrLf, " ")
txt = Replace(txt, vbCr, " ")
txt = Replace(txt, vbLf, " ")
txt = regex.Replace(txt, "")
txt = Trim(txt)
If Len(txt) > 31 Then txt = Left(txt, 31)
If Len(txt) = 0 Then GoTo NextPage
' Π·Π°ΡΠΈΡΠ° ΠΎΡ Π΄ΡΠ±Π»Π΅ΠΉ
txt = MakeUniquePageName(doc, txt)
On Error Resume Next
pg.Name = txt
On Error GoTo 0
NextPage:
Next pg
MsgBox "ΠΠ΅ΡΠ΅ΠΈΠΌΠ΅Π½ΠΎΠ²Π°Π½ΠΈΠ΅ ΡΡΡΠ°Π½ΠΈΡ Π·Π°Π²Π΅ΡΡΠ΅Π½ΠΎ.", vbInformation
End Sub
Function MakeUniquePageName(doc As Document, baseName As String) As String
Dim nameTry As String
Dim counter As Integer
Dim p As Page
Dim exists As Boolean
nameTry = baseName
counter = 1
Do
exists = False
For Each p In doc.Pages
If p.Name = nameTry Then
exists = True
Exit For
End If
Next p
If Not exists Then Exit Do
nameTry = baseName & "_" & counter
counter = counter + 1
Loop
MakeUniquePageName = nameTry
End Function
This media is not supported in your browser
VIEW IN TELEGRAM
αααα αα·αααααΎα
β€1
ααΆαααααααααααΎαααααΎααααα’αΆααααααααααααααΆαα
αααΎαααααΆααααααΆααααααΎααΆαααααΎαααΎαααΆαα
Size:
A4,
A3,
40*60,
50*70,
30*120,
60*120,
60*90,
60*85,
75*120,
Size:
A4,
A3,
40*60,
50*70,
30*120,
60*120,
60*90,
60*85,
75*120,