VBA: applying styles to text range

Hello,

I want to apply a different character style to some characters of an artistic text in CorelDRAW 2024.

Following the help from here, and here I made the next script:

Sub Test3()
Dim t As Text
Dim s As Shape
Dim s2 As Shape
Dim st As Styles
Dim d As Document
Set d = CreateDocument
Set s2 = d.ActiveLayer.CreateArtisticText(4, 6, "text for creating a style", , , "Arial", 36, cdrTrue)
Set st = d.StyleSheet.CreateStyleFromShape(s2, "character", "Test style", True)
Set s = d.ActiveLayer.CreateArtisticText(4, 5, "This is a test.")
Set t = s.Text
MsgBox "The text between characters 10 and 14 is: " & vbCr & t.Range(10, 14).Text
t.Range(10, 14).Case = cdrAllCapsFontCase
t.Range(10, 14).ApplyStyle "Test style"
End Sub

The last line with ApplyStyle doesn't do anything, the selected characters remains with the original formating.

Am I doing something wrong?

  • I've had a similar problem. Sometimes styles created on the fly via macros don't seem to stick.

    I'll have to save the document and reopen before the style works.

    Maybe the VBA gurus will chime in with their views! : )

    • I also couldn't solve it using the style properties, but I already needed to do that and I solved it as follows.

      Sub Test4()
      Dim s As Shape
      Dim h As Shape
      Dim d As Document
      Dim c As String
      Dim r As String
      Dim t As Integer

      Set d = ActiveDocument
      Set h = d.ActiveLayer.CreateArtisticText(4, 6, "text for creating a style", , , "Verdana", 36, cdrTrue)
      Set s = d.ActiveLayer.CreateArtisticText(4, 5, "This is a test on text.")

      c = "test"
      r = s.Text.Story.Text

      t = InStr(1, r, c, vbTextCompare)

      If t <> 0 Then
      With s.Text.Range(t - 1, t + Len(c) - 1)
      .Case = cdrAllCapsFontCase
      .Size = h.Text.Story.Size
      .Font = h.Text.Story.Font
      .Bold = h.Text.Story.Bold
      End With
      End If

      MsgBox "The word: '" & c & "' was found in the text: " & vbCr & r, vbInformation, s.Text.Story
      End Sub