αααα»αα±ααΆααα·ααΈαα»αααα
αΌαααααΆαααααΈαααααααΈααΆαα·ααααα
ααΆααααα»αααΆαααααααααΆα α ααα½α α₯ αααα
α αΆααααΈααααααΈα‘α’ ααα α‘α¦ ααααααΆ ααααΆαα’α α’α¦α
ααΉαα αΌααααααΎααΆαααΆαααΌαααααααΈα‘α§ ααααααΆ ααααΆαα’α α’α¦ ααΆααααααΆα
ααΎααααα»αααΌααααααα’αααα’ααα»ααααΆαααααΆααααα αααα’αα·αα·ααααΆααα’αα
αααααΆαααΆααααααΆαααΎααααα»αααααααα αα·αααααααΆααααααΆαα·α αα ααΆαα
ααΌαααΌαααα’αα·αα·ααααΆααα’ααα’αα ααααα½αααΆαααΆαααΆα αα·ααα½ααααα»ααααα α€αααααΆα α’αΆαα» αααα αα»α αα·α αα αααααΈααΆαααα»αααΎααααααααααααααααα
ααΎααααα»αααΌααααααΈα’ααααααα ααααααΆαααααΎααααααααΆαααΆαααΊααααΆαααααααα ααΌαα’αααααα αα·αα’ααα»ααα»αααΆαα»αα
ααΆααααα»αααΆαααααααααΆα α ααα½α α₯ αααα
α αΆααααΈααααααΈα‘α’ ααα α‘α¦ ααααααΆ ααααΆαα’α α’α¦α
ααΉαα αΌααααααΎααΆαααΆαααΌαααααααΈα‘α§ ααααααΆ ααααΆαα’α α’α¦ ααΆααααααΆα
ααΎααααα»αααΌααααααα’αααα’ααα»ααααΆαααααΆααααα αααα’αα·αα·ααααΆααα’αα
αααααΆαααΆααααααΆαααΎααααα»αααααααα αα·αααααααΆααααααΆαα·α αα ααΆαα
ααΌαααΌαααα’αα·αα·ααααΆααα’ααα’αα ααααα½αααΆαααΆαααΆα αα·ααα½ααααα»ααααα α€αααααΆα α’αΆαα» αααα αα»α αα·α αα αααααΈααΆαααα»αααΎααααααααααααααααα
ααΎααααα»αααΌααααααΈα’ααααααα ααααααΆαααααΎααααααααΆαααΆαααΊααααΆαααααααα ααΌαα’αααααα αα·αα’ααα»ααα»αααΆαα»αα
αααααΆααααΆαααΆααααα αΆααααααα
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,