[CDR X5-X8] Ctrl+K массово

berTalino

Участник
Топикстартер
Сообщения
110
Реакции
1
Ребят, есть вопрос.

Не знает ли кто, ка можно разделить строки/символы (CTRL+K) не у выделенного объекта, а у двух, трех и более, выбранных через CTRL.

Спрашиваю потому, что это иногда бывает нужно, а базовые функци не позволяют.
 
Последнее редактирование:

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
Макросом
 

berTalino

Участник
Топикстартер
Сообщения
110
Реакции
1
Взываю о помощи.

Кто-нибудь может помочь с написанием такого макроса ?
 

dastin

Некромант-любитель
12 лет на форуме
Сообщения
2 131
Реакции
2 027
это будет очень ... вы даже не представляете как ...
Код:
Sub BreakAP()
Dim s As Shape
    For Each s In ActiveSelection.Shapes
    s.BreakApart
    Next s
End Sub
 

berTalino

Участник
Топикстартер
Сообщения
110
Реакции
1
это будет очень ... вы даже не представляете как ...
Код:
Sub BreakAP()
Dim s As Shape
    For Each s In ActiveSelection.Shapes
    s.BreakApart
    Next s
End Sub

Огромное спасибо!
Я попробовал и выяснилось, что это получается простая имитация CTRL+K.

Типа когда абзац или предложение разъединяется, активным остается 1 элемент... Что не дает возможности делить дальше ... хм
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
Вы ж вразумительно задачу не поставили. Формально данный макрос топиковую хотелку реальзует. А что еще надо? Чтоб выделение оставалось или как?
 

berTalino

Участник
Топикстартер
Сообщения
110
Реакции
1
Вы ж вразумительно задачу не поставили. Формально данный макрос топиковую хотелку реальзует. А что еще надо? Чтоб выделение оставалось или как?

Я подготовлю документ сегодня-завтра - покажу конкретно, что имею в виду.
 

berTalino

Участник
Топикстартер
Сообщения
110
Реакции
1
Всем снова доброго дня!

Итак, я подготовил примерную страничку, на которой при импорте в корел фразы рандомно завязаны друг с другом, и если расцеплять их по Ctrl+K, то это нужно сделать раз 10-20 ()..
Без этого колонки и фразы нормально не подвигаешь.

Суть Топика - в том, чтобы найти способ 1 нажатием клавиш или макросом РАСЦЕПИТЬ сразу все связки, даже если они расцепят абсолютно все посимвольно (нередко это очень помогает)

P.S.: я на самом деле не знаю, как максимально доходчиво представить эту ситуацию, по сему приходится показывать файлы (что на форуме, скорее сего , нельзя)

Если удобно, отпишите, пожалуйста в личку - дам ссылку на страничку на яндекс диске..
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835

dastin

Некромант-любитель
12 лет на форуме
Сообщения
2 131
Реакции
2 027
Так и недождамшись ...

Почитал Шелби Мура
чуть поправил легкой кувалдочкой
2017-11-29_19-04-11.png
Код:
Option Explicit

Private Sub UserForm_Initialize()
Dim ii As Double, jj As Double
    ii = CDbl(GetSetting("DS", "Razlu4niK", "WindowX", 75))
    UFBreak.Left = ii
    jj = CDbl(GetSetting("DS", "Razlu4niK", "WindowY", 75))
    UFBreak.Top = jj
End Sub
Sub cmdBreak_Click()

Set srSel = ActiveSelection.Shapes.FindShapes(Query:="@type ='text:artistic' or @type ='text:paragraph'")
Set srAll = ActivePage.Shapes.FindShapes(Query:="@type ='text:artistic' or @type ='text:paragraph'")
    Optimization = True
    ActiveDocument.BeginCommandGroup "Razlu4niK"
    EventsEnabled = False
    ActiveDocument.PreserveSelection = False
    ActiveDocument.SaveSettings
'Break to Line
        Set srLine = srSel.Shapes.FindShapes(Query:="@com.text.story.Lines.Count > 1")
            For Each s In srLine
            On Error Resume Next
            s.Text.ConvertToArtistic
            s.BreakApart
            Next s
        If chkLine.Value = True Then
        GoTo ExSub:
        Else
        Set srWord = ActivePage.Shapes.FindShapes(Query:="@type ='text:artistic' or @type ='text:paragraph'")
        srAll.RemoveRange srSel
        srWord.RemoveRange srAll
        End If
'Break to Word
        For Each s In srWord.Shapes.FindShapes(Query:="@com.text.story.Words.Count > 1")
        s.BreakApart
        Next s
        If chkWord.Value = True Then
        GoTo ExSub:
        Else
        Set srChar = ActivePage.Shapes.FindShapes(Query:="@type ='text:artistic' or @type ='text:paragraph'")
        srAll.RemoveRange srSel
        srChar.RemoveRange srAll
        End If
'Break to Characters
        For Each s In srChar.Shapes.FindShapes(Query:="@com.text.story.Characters.Count > 1")
        s.BreakApart
        Next s
ExSub:
    ActiveDocument.RestoreSettings
    ActiveDocument.PreserveSelection = True
    EventsEnabled = True
    Optimization = False
    ActiveWindow.Refresh
    Application.Refresh
    ActiveDocument.EndCommandGroup
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    SaveSetting "DS", "Razlu4niK", "WindowX", CStr(Left)
    SaveSetting "DS", "Razlu4niK", "WindowY", CStr(Top)
End Sub

ну и сам РАЗЛУЧНИК
 
  • Спасибо
Реакции: berTalino

berTalino

Участник
Топикстартер
Сообщения
110
Реакции
1
Так и недождамшись ...

Почитал Шелби Мура
чуть поправил легкой кувалдочкой
Посмотреть вложение 100825
Код:
Option Explicit

Private Sub UserForm_Initialize()
Dim ii As Double, jj As Double
    ii = CDbl(GetSetting("DS", "Razlu4niK", "WindowX", 75))
    UFBreak.Left = ii
    jj = CDbl(GetSetting("DS", "Razlu4niK", "WindowY", 75))
    UFBreak.Top = jj
End Sub
Sub cmdBreak_Click()

Set srSel = ActiveSelection.Shapes.FindShapes(Query:="@type ='text:artistic' or @type ='text:paragraph'")
Set srAll = ActivePage.Shapes.FindShapes(Query:="@type ='text:artistic' or @type ='text:paragraph'")
    Optimization = True
    ActiveDocument.BeginCommandGroup "Razlu4niK"
    EventsEnabled = False
    ActiveDocument.PreserveSelection = False
    ActiveDocument.SaveSettings
'Break to Line
        Set srLine = srSel.Shapes.FindShapes(Query:="@com.text.story.Lines.Count > 1")
            For Each s In srLine
            On Error Resume Next
            s.Text.ConvertToArtistic
            s.BreakApart
            Next s
        If chkLine.Value = True Then
        GoTo ExSub:
        Else
        Set srWord = ActivePage.Shapes.FindShapes(Query:="@type ='text:artistic' or @type ='text:paragraph'")
        srAll.RemoveRange srSel
        srWord.RemoveRange srAll
        End If
'Break to Word
        For Each s In srWord.Shapes.FindShapes(Query:="@com.text.story.Words.Count > 1")
        s.BreakApart
        Next s
        If chkWord.Value = True Then
        GoTo ExSub:
        Else
        Set srChar = ActivePage.Shapes.FindShapes(Query:="@type ='text:artistic' or @type ='text:paragraph'")
        srAll.RemoveRange srSel
        srChar.RemoveRange srAll
        End If
'Break to Characters
        For Each s In srChar.Shapes.FindShapes(Query:="@com.text.story.Characters.Count > 1")
        s.BreakApart
        Next s
ExSub:
    ActiveDocument.RestoreSettings
    ActiveDocument.PreserveSelection = True
    EventsEnabled = True
    Optimization = False
    ActiveWindow.Refresh
    Application.Refresh
    ActiveDocument.EndCommandGroup
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    SaveSetting "DS", "Razlu4niK", "WindowX", CStr(Left)
    SaveSetting "DS", "Razlu4niK", "WindowY", CStr(Top)
End Sub

ну и сам РАЗЛУЧНИК

Огромное спасибо ! Задача Топика РЕШЕНА !
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
  • Спасибо
Реакции: Ivan_ и berTalino