VB VBA'da aynı Metin Kutusu'ndaki Metin Yazı Tipini Değiştir

Question

VBA içinde, PPT slaydında hepsi aynı metin kutusu (WarningData) içinde çıktılarının olduğu birden çok alt birimim var. Örneğin, Sub 1 bir kullanıcı seçimini (bir GUI içindeki bir açılır menüden yaptıkları bir seçim) alır ve bunu metin kutusunun üst kısmına ekler. Alt 2, bu satırın altında başka bir metin satırı ekler. Alt 3, bunun altında ek metin ekler. Aynı yazı tipine sahip olmak için Sub 1 ve 2'ye ihtiyacım var, ancak Sub 3'ün farklı bir fontu olması gerekiyor.

Private Sub 3() 
Call Dictionary.Call2Action 

ComboBoxList = Array(CStr(ComboBox7)) 

    For Each Ky In ComboBoxList 

    On Error Resume Next 
    'If nothing is selected in ComboBox7 and TextBox9, do nothing and exit this sub. 
    If ComboBox7 = "" And TextBox9 = "" Then 
    Exit Sub 
    'Otherwise, if either has a selection, insert selected text. 
    ElseIf ComboBox7 <> "" And TextBox9 = "" Then 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange = _ 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange & vbCrLf & vbCrLf & dict7.Item(Ky)(0) 
    ElseIf ComboBox7 = "" And TextBox9 <> "" Then 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange = _ 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange & vbCrLf & vbCrLf & TextBox9 

    End If 

Next 

Set dict7 = Nothing 

End Sub 

bu Herhangi bir fikir

eğer

:

Private Sub 1() 'Sub 2 is very similar. 
Call Dictionary.WindInfo 

    'Sets the font for the warning information text. 

    With ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange.Font 

    .Size = 24 
    .Name = "Calibri" 
    .Bold = msoTrue 
    .Shadow.Visible = True 
    .Glow.Radius = 10 
    .Glow.Color = RGB(128, 0, 0) 

    End With 

ComboBoxList = Array(CStr(ComboBox3), CStr(ComboBox4)) 

    For Each Ky In ComboBoxList 

    On Error Resume Next 
    'If nothing is selected in ComboBox4, do nothing and exit this sub. 
    If ComboBox4 = "" Then 
    Exit Sub 
    ElseIf ComboBox3 = "" Then 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange = _ 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange & dict3.Item(Ky)(0) 
    'Otherwise, if it has a selection, insert selected text. 
    ElseIf ComboBox3 <> "" Then 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange = _ 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange & vbCrLf & vbCrLf & dict3.Item(Ky)(0) 

    End If 

Next 

Set dict3 = Nothing 

End Sub 

aşağıdaki alt ben farklı yazı tipi stili olması gerekir biridir: Burada

neyi Alt 1 ve Alt 2 bakmak gibidir mümkün?

Teşekkürler!

Answer 1

:

Private Sub 3() 
Call Dictionary.Call2Action 

ComboBoxList = Array(CStr(ComboBox7)) 

    For Each Ky In ComboBoxList 
    On Error Resume Next 
    With ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2 
     'If nothing is selected in ComboBox7 and TextBox9, do nothing and exit this sub. 
     If ComboBox7 = "" And TextBox9 = "" Then 
     Exit Sub 
     'Otherwise, if either has a selection, insert selected text. 
     ElseIf ComboBox7 <> "" And TextBox9 = "" Then 
     .TextRange = .TextRange & vbCrLf & vbCrLf & dict7.Item(Ky)(0) 
     .TextRange.Paragraphs(3).Font.Size = 18 
     .TextRange.Paragraphs(3).Font.Name = "Calibri" 
     .TextRange.Paragraphs(3).Font.Fill.ForeColor.RGB = vbWhite 
     .TextRange.Paragraphs(3).Font.Bold = msoTrue 
     .TextRange.Paragraphs(3).Font.Glow.Transparency = 1 
     ElseIf ComboBox7 = "" And TextBox9 <> "" Then 
     .TextRange = .TextRange & vbCrLf & vbCrLf & TextBox9 
     .TextRange.Paragraphs(3).Font.Size = 18 
     .TextRange.Paragraphs(3).Font.Name = "Calibri" 
     .TextRange.Paragraphs(3).Font.Fill.ForeColor.RGB = vbWhite 
     .TextRange.Paragraphs(3).Font.Bold = msoTrue 
     End If 
    End With 
    Next 

    Set dict7 = Nothing 

End Sub 

Answer 2

Bir With ifadesini kullanarak kodu basitleştirdim ve Yazı tipi adının nasıl ayarlanacağını göstermek için 2 x yazı tipi satırı ekledim. Diğer özellikler ayrıca Font2 nesnesinde mevcuttur. .Size, .Bold, .Kasaya vb bu görevi başarmak için ben başardı TextRange.Paragraphs yöntemi kullanarak

Private Sub Three() 
    Call Dictionary.Call2Action 

    ComboBoxList = Array(CStr(ComboBox7)) 

    For Each Ky In ComboBoxList 
    On Error Resume Next 
    With ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2 
     'If nothing is selected in ComboBox7 and TextBox9, do nothing and exit this sub. 
     If ComboBox7 = "" And TextBox9 = "" Then 
     Exit Sub 
     'Otherwise, if either has a selection, insert selected text. 
     ElseIf ComboBox7 <> "" And TextBox9 = "" Then 
     .TextRange = .TextRange & vbCrLf & vbCrLf & dict7.Item(Ky)(0) 
     .TextRange.Font.Name = "Calibri" 
     ElseIf ComboBox7 = "" And TextBox9 <> "" Then 
     .TextRange = .TextRange & vbCrLf & vbCrLf & TextBox9 
     .TextRange.Font.Name = "Calibri" 
     End If 
    End With 
    Next 

    Set dict7 = Nothing 

End Sub