CODEWITHSUNDEEP
excelvba
Satu
Satu

Reputation: 11

Editing a string in Excel VBA userform using special characters

I'm trying to write a program for a userform in excel for editing chart title and other things. I want write a code that uses special characters i.e. {like this} and changes the text inside the cutely brackets to subscript and I want to able to do this multiple times: The following code this but only for the first occurrence.

Public Font_Name As String, Font_Style As String, Half_Height As Integer

Sub CommandButton1_Click()
'********************Define Standardized Plot Settings******************
    Font_Name = "Arial"
    Font_Style = "Normal"
    Title_Font_Size = 28
    Axes_Label_Font_Size = 22
    Tick_Lable_Font_Size = 20
    PlotArea_Border_Color_R = 0
    PlotArea_Border_Color_G = 0
    PlotArea_Border_Color_B = 0
    PlotArea_Border_Weight = 3
    PlotArea_Border_Weight_Pass = PlotArea_Border_Weight
    Grid_Color_R = 150
    Grid_Color_G = 150
    Grid_Color_B = 150
    Grid_Weight = 2
    Grid_Weight_Pass = Grid_Weight
'*****************End Define Standardized Plot Settings*****************

'****************************Format the plot********************************
'----------------------------Format the Title-------------------------------

'*****Searches Char Title for {} and replaces everything indside as subscript***

With ActiveChart
        .HasTitle = True
        .ChartTitle.Text = Me.Chart_Title.Text
        .ChartTitle.Characters.Font.Name = Font_Name
        .ChartTitle.Characters.Font.FontStyle = Font_Style
        .ChartTitle.Characters.Font.Size = Title_Font_Size  'works
          If Me.FontOveride <> "" Then
        .ChartTitle.Characters.Font.Size = Me.FontOveride
         Else
        .ChartTitle.Characters.Font.Size = Title_Font_Size  'works
         End If

searchString = Me.Chart_Title.Text
Char1 = "{"
Char2 = "}"

For i = 1 To Len(searchString)
    If Mid(searchString, i, 1) = Char1 Then
    startPos = i
    Exit For
    Else:
    End If
    Next i

For j = 1 To Len(searchString)
    If Mid(searchString, j, 1) = Char2 Then
    endPos = j
    Exit For
    Else:
    End If
    Next j

If startPos >= 1 Or endPos >= 1 Then
    .ChartTitle.Characters(startPos, endPos - startPos).Font.Subscript = True
    .ChartTitle.Characters(startPos, 1).Delete
    .ChartTitle.Characters(endPos - 1, 1).Delete
    Else:
    End If

End With


'***************************************************************************


'***************************************************************************
'----------------------------Format the X Axis-------------------------------
With ActiveChart.Axes(xlCategory)
        .HasTitle = True
        .AxisTitle.Characters.Text = Me.X_Axis_Title
        .AxisTitle.Characters.Font.Name = Font_Name
        .AxisTitle.Characters.Font.FontStyle = Font_Style
        .AxisTitle.Characters.Font.Size = Axes_Label_Font_Size
        .TickLabels.Font.Name = Font_Name
        .TickLabels.Font.FontStyle = Font_Style
        .TickLabels.Font.Size = Tick_Lable_Font_Size
        .MajorTickMark = xlTickMarkNone
        .MinimumScale = Me.X_Axis_Start
        .MaximumScale = Me.X_Axis_Stop
        .MajorUnit = Me.X_Axis_Step
        .CrossesAt = Me.X_Axis_Start
        .HasMajorGridlines = True
        .MajorGridlines.Border.Color = RGB(Grid_Color_R, Grid_Color_G, Grid_Color_B)
        .MajorGridlines.Border.Weight = Grid_Weight_Pass
        .Border.Color = vbBlack

'*****Searches X-Axis for {} and replaces everything indside as subscript*******
searchString = Me.X_Axis_Title
Char1 = "{"
Char2 = "}"
For i = 1 To Len(searchString)
    If Mid(searchString, i, 1) = Char1 Then
        Pos1 = i
    Exit For
    Else:
   'End If
   End If
Next i

For j = 1 To Len(searchString)
    If Mid(searchString, j, 1) = Char2 Then
    Pos2 = j
    Exit For
    Else:
     'End If
    End If
Next j

If Pos1 >= 1 And Pos2 >= 1 Then
.AxisTitle.Characters(Pos1, Pos2 - Pos1).Font.Subscript = True
.AxisTitle.Characters(Pos1, 1).Delete
.AxisTitle.Characters(Pos2 - 1, 1).Delete
Else:
End If

End With
'----------------------------Format the Y Axis-------------------------------
With ActiveChart.Axes(xlValue)
        .HasTitle = True
        .AxisTitle.Characters.Text = Me.Y_Axis_Title
        .AxisTitle.Characters.Font.Name = Font_Name
        .AxisTitle.Characters.Font.FontStyle = Font_Style
        .AxisTitle.Characters.Font.Size = Axes_Label_Font_Size
        .TickLabels.Font.Name = Font_Name
        .TickLabels.Font.FontStyle = Font_Style
        .TickLabels.Font.Size = Tick_Lable_Font_Size

On Error GoTo Skip
Decimal_Position = Len(Me.Y_Axis_Step.Text) - WorksheetFunction.Search(".", Me.Y_Axis_Step.Text)
Format_String = "#,##0." & WorksheetFunction.Rept("0", Decimal_Position)
        .TickLabels.NumberFormat = Format_String
GoTo Skip2
Skip:
On Error GoTo 0
        .TickLabels.NumberFormat = "#,##0"
Skip2:

        .MajorTickMark = xlTickMarkNone
        .MinimumScale = Me.Y_Axis_Start
        .MaximumScale = Me.Y_Axis_Stop
        .MajorUnit = Me.Y_Axis_Step
        .CrossesAt = Me.Y_Axis_Start
        .HasMajorGridlines = True
        .MajorGridlines.Border.Color = RGB(Grid_Color_R, Grid_Color_G, Grid_Color_B)
        .MajorGridlines.Border.Weight = Grid_Weight_Pass
        .Border.Color = vbBlack


'*****Searches Y Axis for {} and replaces everything indside as subscript*******
searchString = Me.Y_Axis_Title
Char1 = "{"
Char2 = "}"
For i = 1 To Len(searchString)
    If Mid(searchString, i, 1) = Char1 Then
        Pos3 = i
    Exit For
    Else:
   'End If
   End If
Next i

For j = 1 To Len(searchString)
    If Mid(searchString, j, 1) = Char2 Then
    Pos4 = j
    Exit For
    Else:
     'End If
    End If
Next j

If Pos3 >= 1 And Pos4 >= 1 Then
.AxisTitle.Characters(Pos3, Pos4 - Pos3).Font.Subscript = True
.AxisTitle.Characters(Pos3, 1).Delete
.AxisTitle.Characters(Pos4 - 1, 1).Delete
Else:
End If
End With
'****************************End Format the Plot*******************************

Upvotes: 1

Views: 581

Answers (1)

David Zemens
David Zemens

Reputation: 53663

You can use regular expressions with the pattern {[\w]*}.

If you want to use early binding, then it requires reference to Microsoft VBScript Regular Expressions 5.5.

RegEx will give you, in addition to other information the start position & length of each substring, which you can then use to apply the subscript or other formatting as required. 

Sub regTest()
Dim R As Object 'New RegExp
Dim matches As Object 'MatchCollection
Dim m As Variant
Dim str As String

Set R = CreateObject("VBScript.RegExp")

str = "hello {world} this is my {title}"

R.Pattern = "{[\w]*}"
R.Global = True
R.IgnoreCase = True

If R.test(str) Then
    Set matches = R.Execute(str)
    For Each m In matches
        Debug.Print m.Value
        Debug.Print "Starts at: " & m.FirstIndex
        Debug.Print "Lenght: " & m.Length
    Next
End If

End Sub

Upvotes: 1

Related Questions