如何创建字体对象 vba

Question

所以我想这很简单，但我不确定如何创建 Font 对象或任何对象 :( 。我正在尝试复制一个单词的字体并将其应用于另一个项目的另一个字体，但每当我尝试创建一个新的 Font 对象时出现错误（我不能只引用原始对象，因为它在 Font 转移到另一个词之前发生了变化）。我真的是 vba 的新手，所以这可能是一个愚蠢的问题，但我尝试了我在网上看到的一切，但没有运气。这是我在收到的错误旁边尝试的方法：

Sub helo()
-----------------------------

  Dim uno As Font

  Set uno = New Font
 'Invalid use of New Keyword
-----------------------------

Dim uno As Font

  Set uno = New Font1
'User-Defined type not defined
-----------------------------
Dim uno As PowerPoint.Font

  Set uno = New Font1
'User-Defined type not defined
-----------------------------
Dim uno As New Font

 'Invalid use of New Keyword
-----------------------------

End Sub

在此先感谢您的帮助，如果这是一个愚蠢的问题，请原谅我，我是新手。

该项目的代码，我得到了它的功能，但它仍然失去了除粗体和下划线之外的所有格式。其中一些是从我在网上找到的代码复制而来的，一些是我自己编写的。（真的很乱，抱歉）

Sub Traductorpuntosycomas()
Dim regX As Object
Dim osld As Slide
Dim oshp As Shape
Dim intSlide As Integer
Dim strInput As String
Dim b_found As Boolean
Dim iRow As Integer
Dim iCol As Integer
Dim i As Integer
Dim strInput2() As String
Dim Bold(1000) As Integer
Dim Under(1000) As Integer
 

For i = 0 To 999

Bold(i) = 0
Under(i) = 0

Next i



Set regX = CreateObject("vbscript.regexp")


For Each osld In ActivePresentation.Slides


For Each oshp In osld.Shapes

'TABLAS TABLAS TABLAS TABLAS TABLAS TABLAS TABLAS TABLAS TABLAS TABLAS TABLAS TABLAS'

If oshp.HasTable Then


For iRow = 1 To oshp.Table.Rows.Count


For iCol = 1 To oshp.Table.Columns.Count

'111111111111111111111111111111111111111111111111111111111111111111111111'


With regX


.Global = True
.Pattern = "(\d)\.(\d)"


End With


strInput = oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text


strInput2 = Split(strInput, " ")

'BOLD UNDER BOLD UNDER BOLD UNDER BOLD UNDER BOLD UNDER BOLD UNDER BOLD UNDER BOLD UNDER BOLD UNDER'

For i = LBound(strInput2) To 2 * UBound(strInput2)

If oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Words(i + 1).Font.Bold = False Then
Bold(i) = 0
Else
Bold(i) = 1
End If
If oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Words(i + 1).Font.Underline = False Then
Under(i) = 0
Else
Under(i) = 1
End If

'INDENTATIONS INDENTATIONS INDENTATIONS INDENTATIONS INDENTATIONS INDENTATIONS INDENTATIONS INDENTATIONS '



Next i

For i = LBound(strInput2) To UBound(strInput2)

b_found = regX.Test(strInput2(i))


If b_found = True Then


strInput2(i) = regX.Replace(strInput2(i), "¬")


End If

Next i

strInput = Join(strInput2, " ")

oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text = strInput

'222222222222222222222222222222222222222222222222222222222222222222222222'

With regX


.Global = True
.Pattern = "(\d)\,(\d)"


End With


strInput = oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text


strInput2 = Split(strInput, " ")

'FOR'

For i = LBound(strInput2) To UBound(strInput2)


b_found = regX.Test(strInput2(i))


If b_found = True Then


strInput2(i) = regX.Replace(strInput2(i), ".")

End If

Next i

strInput = Join(strInput2, " ")

oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text = strInput

'3333333333333333333333333333333333333333333333333333333333333333333333333333333'

With regX


.Global = True
.Pattern = "(\d)\¬(\d)"


End With


strInput = oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text


strInput2 = Split(strInput, " ")

'FOR'

For i = LBound(strInput2) To UBound(strInput2)


b_found = regX.Test(strInput2(i))


If b_found = True Then


strInput2(i) = regX.Replace(strInput2(i), ",")


End If

Next i

strInput = Join(strInput2, " ")

oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text = strInput

'VUELTA AL FORMATO ORIGINAL'

For i = LBound(strInput2) To 2 * UBound(strInput2)

If Bold(i) = 1 Then
oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Words(i + 1).Font.Bold = True
Else
oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Words(i + 1).Font.Bold = False
End If
If Under(i) = 1 Then
oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Words(i + 1).Font.Underline = True
Else
oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Words(i + 1).Font.Underline = False
End If

Next i

'VUELTA AL FORMATO ORIGINAL'


Next iCol


Next iRow


'FINAL TABLAS FINAL TABLAS FINAL TABLAS FINAL TABLAS FINAL TABLAS FINAL TABLAS'

Else


If oshp.HasTextFrame Then


If oshp.TextFrame.HasText Then

With regX


.Global = True
.Pattern = "(\d)\.(\d)"


End With

 
strInput = oshp.TextFrame.TextRange.Text


strInput2 = Split(strInput, " ")



For i = LBound(strInput2) To 2 * UBound(strInput2)
'BOLD UNDER BOLD UNDER BOLD UNDER V BOLD UNDER BOLD UNDER BOLD UNDER BOLD UNDER'

If oshp.TextFrame.TextRange.Words(i).Font.Bold = False Then
Bold(i) = 0
Else
Bold(i) = 1
End If
If oshp.TextFrame.TextRange.Words(i).Font.Underline = False Then
Under(i) = 0
Else
Under(i) = 1
End If
Next i
For i = LBound(strInput2) To UBound(strInput2)
b_found = regX.Test(strInput2(i))


If b_found = True Then


strInput2(i) = regX.Replace(strInput2(i), "¬")




'oshp.TextFrame.TextRange.Words(i) = strInput2(i)


End If

Next i

strInput = Join(strInput2, " ")

oshp.TextFrame.TextRange.Text = strInput


'1111111111111111111111111111111111111111111111111111111111111111111'

With regX


.Global = True
.Pattern = "(\d)\,(\d)"


End With

 
strInput = oshp.TextFrame.TextRange.Text


strInput2 = Split(strInput, " ")



For i = LBound(strInput2) To UBound(strInput2)


b_found = regX.Test(strInput2(i))


If b_found = True Then


strInput2(i) = regX.Replace(strInput2(i), ".")


'oshp.TextFrame.TextRange.Words(i) = strInput2(i)




End If

Next i

strInput = Join(strInput2, " ")

oshp.TextFrame.TextRange.Text = strInput



'2222222222222222222222222222222222222222222222222222222222222222'


With regX


.Global = True
.Pattern = "(\d)\¬(\d)"


End With

 
strInput = oshp.TextFrame.TextRange.Text


strInput2 = Split(strInput, " ")



For i = LBound(strInput2) To UBound(strInput2)


b_found = regX.Test(strInput2(i))


If b_found = True Then


strInput2(i) = regX.Replace(strInput2(i), ",")


'oshp.TextFrame.TextRange.Words(i) = strInput2(i)

End If


Next i

strInput = Join(strInput2, " ")

oshp.TextFrame.TextRange.Text = strInput


'333333333333333333333333333333333333333333333333333333333333333333333333333'


'VUELTA AL FORMATO ORIGINAL'

For i = LBound(strInput2) To 2 * UBound(strInput2)

If Bold(i) = 1 Then
oshp.TextFrame.TextRange.Words(i).Font.Bold = True
Else
oshp.TextFrame.TextRange.Words(i).Font.Bold = False
End If
If Under(i) = 1 Then
oshp.TextFrame.TextRange.Words(i).Font.Underline = True
Else
oshp.TextFrame.TextRange.Words(i).Font.Underline = False
End If

Next i

'VUELTA AL FORMATO ORIGINAL'


End If


End If


End If



Next oshp


Next osld

Set regX = Nothing





End Sub

Answer 1

这是一个基于您发布的代码的示例。

我不是 100% 确定正则表达式模式，因此您可能需要对其进行调整...

Sub Traductorpuntosycomas()
    
    Dim osld As Slide
    Dim oshp As Shape
    Dim iRow As Integer
    Dim iCol As Integer
    
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If oshp.HasTable Then
                For iRow = 1 To oshp.Table.Rows.Count
                    For iCol = 1 To oshp.Table.Columns.Count
                        FixNumbers oshp.Table.Cell(iRow, iCol).Shape.TextFrame
                    Next iCol
                Next iRow
            End If
        Next oshp
    Next osld
End Sub

'check a textframe object and replace any numbers with their re-formatted form
Sub FixNumbers(tf As TextFrame)
    Dim regX As Object, matches, match, pos1 As Long, pos2 As Long, txt
    
    If Not tf.HasText Then Exit Sub 'nothing to process
    txt = tf.TextRange.Text
    Set regX = CreateObject("vbscript.regexp")
    With regX
        .Global = True
        .Pattern = "\d+\.?\d+,?\d?" 'digits with optional `.` and `,`
    End With
    Set matches = regX.Execute(txt)
    For Each match In matches
        pos1 = InStr(match.Value, ".") 'find .
        pos2 = InStr(match.Value, ",") 'find ,
        'swap out without affecting formatting...
        If pos1 > 0 Then tf.TextRange.Characters(match.firstindex + pos1, 1) = ","
        If pos2 > 0 Then tf.TextRange.Characters(match.firstindex + pos2, 1) = "."
    Next match
End Sub

如何创建字体对象 vba

How to create font object vba

powerpoint

vba