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

លើកទី១ហើយដែរខ្ញុំបានឃើញរូបប្រាសាទអង្គរចេញលើអេក្រង់ថ្ងៃនេះ។យល់យ៉ាងណាដែរបងៗ?

រលោង និងគ្រើម

ការតាំងផ្លូវកាត់

G - Code Play

យប់នេះដាក់ជូនឥតគិតថ្លៃ

ការត្រឡប់ខ្សែបញ្ជ្រាស់ ដើម្បីផ្ចាប់គ្នាជាខ្សែតែមួយ #CorelDRAW To ខ្សែកាត់ JoinSubpaths
សម្រាប់បងៗដែលត្រូវការវាអាចឆាតមកបាន តម្លៃ ២០០០០ រៀល ទេ។
វាមានទូនាទីសម្រាប់ផ្ចាប់ខ្សែកាត់តែប៉ុណ្ណោះ លឿនហើយស្រួល។

ការត្រឡប់ខ្សែបញ្ជ្រាស់ ដើម្បីផ្ចាប់គ្នាជាខ្សែតែមួយ #CorelDRAW To ខ្សែកាត់ JoinSubpaths
សម្រាប់បងៗដែលត្រូវការវាអាចឆាតមកបាន តម្លៃ ២០០០០ រៀល ទេ។
វាមានទូនាទីសម្រាប់ផ្ចាប់ខ្សែកាត់តែប៉ុណ្ណោះ លឿនហើយស្រួល។