'VBA標準モジュール
Option Explicit

'コンボボックスにフォントを設定
Public Sub setFontItems()
Dim Items As String
    With UserForm1
        .cmB_font.Clear  'コンボボックス内初期化
        Items = "Meiryo UI,ＭＳ ゴシック"  '内容をカンマで区切り記載
        .cmB_font.List = Split(Items, ",")  'カンマで区切る
    End With
End Sub

'-------------------指定範囲のフォントを変更------------------------------
Sub changeSelectFont()
    Dim str As String: str = UserForm1.cmB_font.Text  'コンボボックスのフォント名取得
    Dim row As Integer  '表の行カウント用
    Dim col As Integer  '表の列カウント用
    Dim gshp As Shape  'グループシェイプ用
    
    With ActiveWindow.Selection
        If .Type >= ppSelectionText Then  'テキストを選択している場合
            With .TextRange.Font
                .Name = str  'フォント変更
                .NameFarEast = str  'アジア言語のフォント変更フォント変更
            End With
        ElseIf .Type >= ppSelectionShapes Then  'シェイプを選択している場合
            If .ShapeRange.Type = msoTable Then  '表を選択している場合
                With .ShapeRange.Table        '表のフォント変更
                    For row = 1 To .Rows.Count
                        For col = 1 To .Columns.Count
                            .Cell(row, col).Shape.TextFrame.TextRange.Font.Name = str
                            .Cell(row, col).Shape.TextFrame.TextRange.Font.NameFarEast = str
                        Next col
                    Next row
                End With
                Exit Sub
            ElseIf .ShapeRange.Type = msoPicture Then  '図を選択している場合
                MsgBox "図です。"
                Exit Sub
            Else
                If .ShapeRange.HasTextFrame Then  'シェイプを選択している場合
                    With .ShapeRange.TextFrame.TextRange.Font
                        .Name = str
                        .NameFarEast = str
                    End With
                Else
                    If .ShapeRange.Type = msoGroup Then  'グループの時
                        For Each gshp In .ShapeRange.GroupItems
                            If gshp.HasTextFrame Then
                                With .ShapeRange.TextFrame.TextRange.Font
                                    .Name = str
                                    .NameFarEast = str
                                End With
                            End If
                        Next
                    Else
                        MsgBox "テキストフレームを持っていません"
                    End If
                End If
            End If
        Else
            MsgBox "変更箇所を指定してください"
        End If
    End With
End Sub

'VBAユーザーフォーム
Option Explicit

Private Sub cB_font_Click()
    Call changeSelectFont
    'Call changeSlideFont
    'Call changeAllFont
End Sub

'ユーザーフォーム起動時の処理
Public Sub UserForm_Initialize()
    Call setFontItems
End Sub