Is there a way of assigning subscripts/superscripts as shown below?

Question

I've been working on a VBA macro which generates a PPT presentation based on certain values from a spreadsheet. The macro calls a PPT template which I created, and essentially pastes the specified values on placeholders I inputted in the template presentation.

My issue comes with the following lines of code whereby I'm creating a text which should read:

Flow_coolant = (imported cell value) dPCoolant2 + (imported cell value) dPCoolant + (imported cell value)

where "Coolant" are subscripts and "2" is a superscript so as to denote a power.

    Set PPSlide9 = myPresentation.Slides(9)
    With PPSlide9.Shapes("Text Placeholder 1").TextFrame
        With .TextRange.Lines(4)
                .Text = "FlowCoolant = " & Range("DT_Motor_a") & " dPCoolant2 + " & Range("DT_Motor_b") & " dPCoolant + " & Range("DT_Motor_c") & " [L/min]"
                .Characters(5, 7).Font.Subscript = msoTrue
                .Characters(25, 7).Font.Subscript = msoTrue
                .Characters(32, 1).Font.Superscript = msoTrue
                .Characters(46, 7).Font.Subscript = msoTrue
        End With
    End With

As seen in the code, I'm specifying a certain character order number to be made into a subscript and superscript. However, this does not work well when the imported cell value returns a negative value, or an integer as the subscript and superscripts would then be assigned to the incorrect characters because the total character number in the string changes.

Is there a way of specifying the text "Coolant" to be a subscript rather than specifying character number 5-12 subscripted as I've done on: .Characters(5, 7).Font.Subscript = msoTrue

Thanks!

Answer 1

Here's a token-replacement approach:

Sub MainSub()

    Dim pptApp As Object, shp As Object, ws As Worksheet
    
    Set pptApp = GetObject(, "Powerpoint.Application") 'reference running PPT
    
    Set shp = pptApp.ActivePresentation.Slides(1).Shapes(1) 'shape to be modified
    
    Set ws = ThisWorkbook.Sheets("Data")
    
    'replace tokens in the referenced shape
    replaceToken shp, "<v1>", ws.Range("A1").Value
    replaceToken shp, "<v2>", ws.Range("A2").Value
    replaceToken shp, "<v3>", ws.Range("A3").Value

End Sub

Sub replaceToken(shp As Object, token As String, v)
    Dim p As Long
    With shp.TextFrame2.TextRange
        p = InStr(1, .Text, token, vbTextCompare)
        If p > 0 Then
            .Characters(p, Len(token)).Text = v
        End If
    End With
End Sub

Before and after:

Adjusting your posted code:

Dim shp as Object
'...
Set PPSlide9 = myPresentation.Slides(9)
Set shp = PPSlide9.Shapes("Text Placeholder 1")

replaceToken shp, "<v1>", Range("DT_Motor_a").Value
replaceToken shp, "<v1>", Range("DT_Motor_b").Value
replaceToken shp, "<v1>", Range("DT_Motor_c").Value
'...