'========================================================================================= ' 165 ふりがなの配置を設定する '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。(概ね下半分) ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。(概ね上半分) '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim 配置 As Long '★★★ Dim 配置説明 As String Dim タイトル As String Dim スタイル As Long Dim メッセージ As String Dim 応答 As Variant '========================================================================================= Private Sub ふりがなの配置を設定する() '★★★ Selection.Phonetics.Alignment = 配置 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 'ふりがなのセルを選択する 配置 = xlPhoneticAlignNoControl '★★★ コントロールなし おためしメッセージを表示する ふりがなの配置を設定する '★★★ ' 配置 = xlPhoneticAlignLeft '★★★ 左寄せ おためしメッセージを表示する ふりがなの配置を設定する '★★★ ' 配置 = xlPhoneticAlignCenter '★★★ 中央揃え おためしメッセージを表示する ふりがなの配置を設定する '★★★ ' 配置 = xlPhoneticAlignDistributed '★★★ 均等割り付け おためしメッセージを表示する ふりがなの配置を設定する '★★★ End If Range("O13").Select 'カーソルを定位置へ移動する End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する() Select Case 配置 Case 0 配置説明 = "コントロールなし" Case 1 配置説明 = "左寄せ" Case 2 配置説明 = "中央揃え" 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 '-----------------------------------------------------------------------------------------