[CDR X5-X8] Как поставить на паузу

NemoSUN

Топикстартер
15 лет на форуме
Сообщения
229
Реакции
0
Подскажите, пожалуйста:
1. Как написать паузу на 7 сек. Как сейчас есть, не работает. Делает только одну страницу и всё.
2. Как ко времени вставки добавить текст: Сделано:
3. Как сделать контур букв в цвет заливки
Код:
Sub DataOnPage()
Dim DataPage As String
Dim dLayer As Layer
Dim y As Integer
For Each Document In Application.Documents
Document.Activate
ActiveDocument.Unit = cdrMillimeter
For Each dLayer In ActiveDocument.ActivePage.Layers
        If dLayer.Name = "DataPage" Then
        ActiveDocument.ActivePage.Layers("DataPage").Delete
        End If
        Next dLayer
        ActiveDocument.ActivePage.CreateLayer ("DataPage")
        ActiveDocument.ActivePage.Layers("DataPage").Activate
        ActiveDocument.ActiveLayer.CreateArtisticText ActivePage.CenterX + 70, ActivePage.BottomY + 1.51, CStr(Date), _
        cdrRussian, , "Arial", 8, cdrFalse, cdrFalse, , cdrCenterAlignment
        ActiveShape.Fill.UniformColor.CMYKAssign 0, 100, 100, 0
        ActiveLayer.Editable = False
        ActiveDocument.ActivePage.Layers("DataPage").MoveBelow ActiveDocument.ActivePage.Layers.Bottom
        ActiveDocument.Save
        Application.Wait 1
        Next
End Sub
 
по живому ...
Код:
Sub DataOnPage()

Dim DataPage As String, dLayer As Layer, y As Integer, x As Single

For Each Document In Application.Documents
Document.Activate
ActiveDocument.Unit = cdrMillimeter

    For Each dLayer In ActiveDocument.ActivePage.Layers
        If dLayer.Name = "DataPage" Then
            ActiveDocument.ActivePage.Layers("DataPage").Delete
        End If
    Next dLayer

        ActiveDocument.ActivePage.CreateLayer ("DataPage")
        ActiveDocument.ActivePage.Layers("DataPage").Activate
        ActiveDocument.ActiveLayer.CreateArtisticText ActivePage.CenterX + 70, ActivePage.BottomY + 1.51, CStr(Date) & " «Всё выполнено, господин фельдкурат!» — радостно сообщил Швейк.", _
        cdrRussian, , "Arial", 8, cdrFalse, cdrFalse, , cdrCenterAlignment

        ActiveShape.Fill.UniformColor.CMYKAssign 0, 100, 100, 0
        ActiveShape.Outline.Width = 0.2
        ActiveShape.Outline.Color.CMYKAssign 0, 100, 100, 0
        ActiveLayer.Editable = False
        ActiveDocument.ActivePage.Layers("DataPage").MoveBelow ActiveDocument.ActivePage.Layers.Bottom
        ActiveDocument.Save
        
        x = Timer
        StopSub (7)
        MsgBox " Следующий!"

Next

End Sub

Private Function StopSub(Pause As Single)
Dim Start As Single
Start = Timer
Do While Timer < Start + Pause
   DoEvents
Loop
End Function

Пауза будет между обработкой каждого документа
Она сделана через фунцию StopBus
Весь код должен быть в одном модуле
Цвет заливки, контура и толщину контура можно корректировать
 
  • Спасибо
Реакции: mnemonix и NemoSUN
по живому ...
Код:
Sub DataOnPage()

Dim DataPage As String, dLayer As Layer, y As Integer, x As Single

For Each Document In Application.Documents
Document.Activate
ActiveDocument.Unit = cdrMillimeter

    For Each dLayer In ActiveDocument.ActivePage.Layers
        If dLayer.Name = "DataPage" Then
            ActiveDocument.ActivePage.Layers("DataPage").Delete
        End If
    Next dLayer

        ActiveDocument.ActivePage.CreateLayer ("DataPage")
        ActiveDocument.ActivePage.Layers("DataPage").Activate
        ActiveDocument.ActiveLayer.CreateArtisticText ActivePage.CenterX + 70, ActivePage.BottomY + 1.51, CStr(Date) & " «Всё выполнено, господин фельдкурат!» — радостно сообщил Швейк.", _
        cdrRussian, , "Arial", 8, cdrFalse, cdrFalse, , cdrCenterAlignment

        ActiveShape.Fill.UniformColor.CMYKAssign 0, 100, 100, 0
        ActiveShape.Outline.Width = 0.2
        ActiveShape.Outline.Color.CMYKAssign 0, 100, 100, 0
        ActiveLayer.Editable = False
        ActiveDocument.ActivePage.Layers("DataPage").MoveBelow ActiveDocument.ActivePage.Layers.Bottom
        ActiveDocument.Save
       
        x = Timer
        StopSub (7)
        MsgBox " Следующий!"

Next

End Sub

Private Function StopSub(Pause As Single)
Dim Start As Single
Start = Timer
Do While Timer < Start + Pause
   DoEvents
Loop
End Function

Пауза будет между обработкой каждого документа
Она сделана через фунцию StopBus
Весь код должен быть в одном модуле
Цвет заливки, контура и толщину контура можно корректировать
Спасибо, спасибо, огромное спасибо ))) И ещё раз: спасибо, спасибо... Бью челом - спасибо !!!!! А то сначала из Corel в PDF, потом в Acrobat доделывать....