'========================================================================================= ' 163 ふりがなの種類を設定する '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。(概ね下半分) ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。(概ね上半分) '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim 種類 As Long '★★★ Dim 種類説明 As String Dim タイトル As String Dim スタイル As Long Dim メッセージ As String Dim 応答 As Variant '========================================================================================= Private Sub ふりがなの種類を設定する() '★★★ Selection.Phonetics.CharacterType = 種類 End Sub '========================================================================================= '----------------------------------------------------------------------------------------- Sub おためしマクロ() Worksheets("Title").Select Assistant.Move xLeft:=240, yTop:=320 'アシスタントの表示位置を設定する If Worksheets("Title").Range("K1").Value < "9.0" Then 'Excel2000より前なら 使えませんメッセージを表示する Else Range("E8").Select 'ふりがなのセルを選択する 種類 = xlKatakanaHalf '半角カタカナ おためしメッセージを表示する ふりがなの種類を設定する '★★★ ' 種類 = xlKatakana '全角カタカナ おためしメッセージを表示する ふりがなの種類を設定する '★★★ ' 種類 = xlHiragana 'ひらがな おためしメッセージを表示する ふりがなの種類を設定する '★★★ End If Range("O13").Select 'カーソルを定位置へ移動する End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する() Select Case 種類 Case 0 種類説明 = "半角カタカナ" Case 1 種類説明 = "全角カタカナ" Case Else 種類説明 = "ひらがな" End Select With Assistant.NewBalloon .Text = "ふりがなの種類を {cf 249}" & 種類 & _ ": " & 種類説明 & "{cf 0} に設定します" .Show End With End Sub '----------------------------------------------------------------------------------------- Private Sub 使えませんメッセージを表示する() タイトル = "500連発 第2弾 サンプルマクロ" スタイル = 48 'vbExclamation メッセージ = "ふりがな機能は、Excel2000の新機能です。" & Chr(13) & Chr(13) & _ "以前のバージョンでは使えません" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Sub Auto_Close() Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない ActiveWorkbook.Close '現在開いているブックを閉じる End Sub '-----------------------------------------------------------------------------------------