TexToWord.bas

Attribute VB_Name = "NewMacros"
Public Sub TexToWord()
'
' texToWord Macro
'選択範囲の
'・改行を削除
'・{\tt hogehoge}があった場合に，hogehogeをconsolasにして，{\ttと}を削除する
'・{\em fugafufa}があった場合に，fugafugaをイタリックにして，{\emと}を削除する
'
' 型の定義
  Dim r As Word.Range
  
  ' 選択中の文章を範囲とする
  Set r = Selection.Range
  Set ran = Selection.Range
  
  ' 選択中の文章に対して改行があれば半角スペースに置換する
  ' スペースが複数ある場合も一つにする
  With r
    .Text = Replace(.Text, vbCr, " ")
    .Text = Replace(.Text, "  ", " ")
    '.Font.Name = "Times New Roman"
  End With
  
  
  ' {\tt hogehoge}があった場合
  With r.Find
    '検索または置換操作の条件として書式を含めない場合
    .ClearFormatting
    .Text = "[{]\\tt*[}]"
    .Forward = True ' 下方向に検索
    .MatchWildcards = True ' 検索後にワイルドカードの使用を許可
    .Wrap = wdFindStop ' 範囲外に検索がいかないようにする 戻って再検索
    .MatchFuzzy = False 'あいまい検索OFF
    Do While .Execute = True ' 発見時true
      'If r.InRange(ran) Then
        r.Font.Name = "Consolas"
      'End If
    Loop
  End With
    
  ' {\em hogehoge}があった場合
  With r.Find
    '検索または置換操作の条件として書式を含めない場合
    .ClearFormatting
    .Text = "[{]\\em*[}]"
    .Forward = True ' 下方向に検索
    .MatchWildcards = True ' 検索後にワイルドカードの使用を許可
    .Wrap = wdFindStop ' 範囲外に検索がいかないようにする 戻って再検索
    .MatchFuzzy = False 'あいまい検索OFF
    Do While .Execute = True ' 発見時true
      'If r.InRange(ran) Then
        r.Font.Italic = True
      'End If
    Loop
  End With
    
  Set r = Nothing

End Sub