Word VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


874 / 886 ←次へ | 前へ→

【13】Re:半角全角変換をするには?
回答  H.C.Shinopy  - 03/1/28(火) 2:14 -

引用なし
パスワード
   これも「Word2002 300の技」に検索のヒントだけが載っていたのですが、
私流に考えて、以下のようなマクロになりました。
全角カタカナの後に続く「・」「ー」(中点・長音符)を半角に変換する処理と、
Officeアシスタントによる「OK・キャンセル」ボタン処理を付け足しました。
(但し、このボタン処理は「KatakanaHalfWidth」を実行した場合。
御不要な場合は「KatakanaHalfWidthExec」のみ実行して下さい。)
尚、「‐」「ヽ」「ヾ」(ハイフン・カタカナ繰り返し記号)は、
該当する半角文字がないため変換しません。

Sub KatakanaHalfWidth()
' 全角カタカナを半角に変換一括変換
' 記録日 2003/01/27 記録者 Shinopy
 Dim bBeforeRunVisible As Boolean
 Dim iLabelValue As Integer
'
 bBeforeRunVisible = Assistant.Visible
'
 With Assistant
  .Visible = True
 End With
'
 With Assistant.NewBalloon
  .Animation = msoAnimationWritingNotingSomething
  .BalloonType = msoBalloonTypeButtons
  .Icon = msoIconAlertQuery
  .Button = msoButtonSetOkCancel
  .Heading = vbCr + "全角カタカナを半角に" + vbCr + "一括変換"
  .Text = "ボタンを選択して下さい。"
  iLabelValue = .Show
 End With
'
 Select Case iLabelValue
  Case -1 ' [OK]ボタン時
   Call KatakanaHalfWidthExec
  Case -2 ' [キャンセル]ボタン時
   With Assistant
    .Animation = msoAnimationIdle
   End With
 End Select
'
 With Assistant.NewBalloon
  If iLabelValue = -2 Then
   .Text = "処理が取り消されました。"
   .Animation = msoAnimationGetAttentionMajor
   .Icon = msoIconAlert
  Else
   .Text = "処理が終了しました。"
   .Animation = msoAnimationCharacterSuccessMajor
   .Icon = msoIconAlertInfo
  End If
  .BalloonType = msoBalloonTypeButtons
  .Button = msoButtonSetOK
  .Heading = vbCr + "全角カタカナを半角に" + vbCr + "一括変換"
  .Show
 End With
 Assistant.NewBalloon.Close
 Assistant.Visible = bBeforeRunVisible
End Sub ' KatakanaHalfWidth  *----*----*
Sub KatakanaHalfWidthExec()
' 記録日 2003/01/27 記録者 Shinopy
' 「‐」「ヽ」「ヾ」(連字符・繰り返し記号)は、変換しません。
 Dim cKatakana As String
 cKatakana = "[ァ-" & ChrW(Val("&h30FA")) & "]" ' &h30FA : 「ヲ゛」
' *----*
' 全角カタカナの後に続く中点・長音符を半角に変換
 Selection.Words(1).Select
 Selection.Collapse wdCollapseStart
'
 With Selection.Find
  .ClearFormatting
  .Text = cKatakana & "{1,}" & "([・ー]{1,})"
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = True
 End With
'
 Do While Selection.Find.Execute
  With Selection.Range
   .CharacterWidth = wdWidthHalfWidth
  End With
  Selection.Collapse wdCollapseEnd
 Loop
' *----*
' 全角カタカナを半角に変換
 Selection.Words(1).Select
 Selection.Collapse wdCollapseStart
'
 With Selection.Find
  .ClearFormatting
  .Text = cKatakana & "{1,}"
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = True
 End With
'
 Do While Selection.Find.Execute
  With Selection.Range
   .CharacterWidth = wdWidthHalfWidth
  End With
  Selection.Collapse wdCollapseEnd
 Loop
End Sub ' KatakanaHalfWidthExec  *----*----*
1,842 hits

【10】半角全角変換をするには? YYS 02/12/26(木) 17:39 質問
【11】Re:半角全角変換をするには? H.C.Shinopy 03/1/22(水) 19:44 回答
【12】Re:半角全角変換をするには? ハンサムなオレ 03/1/27(月) 14:40 質問
【13】Re:半角全角変換をするには? H.C.Shinopy 03/1/28(火) 2:14 回答
【14】Re:半角全角変換をするには? ハンサムなオレ 03/1/28(火) 9:19 お礼

874 / 886 ←次へ | 前へ→
ページ:  ┃  記事番号:
207138
(SS)C-BOARD v3.8 is Free