Excel VBA質問箱 IV

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

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


20310 / 76732 ←次へ | 前へ→

【61844】図形の右クリックメニューに登録したマクロ(テキスト追加)
質問  つん  - 09/6/9(火) 12:45 -

引用なし
パスワード
   こんにちは^^
いつもお世話になります。
久しぶりに質問させていただきます。

普段、オートシェイプのテキストボックスなどに文字を入力することが多々あります。
「明朝体で、上下・左右ともセンタリング」という形が多いので、その形で「テキスト入力」できるマクロを作り(というか作ってもらって^^;)右クリックメニューに登録しました。
その後、「ゴシック」が登場することが増え、そちらにも対応できるマクロを追加(ちょこっとアレンジしだけだけど)しました。

以下がそのコードです。(長くて失礼します)

'==============================================
Sub Auto_Open()
  Dim cBar As Office.CommandBar
  Dim cBarCtrl As Office.CommandBarControl
  Dim cBarCtrl2 As Office.CommandBarControl

  Call Auto_Close
  Set cBar = Application.CommandBars("Shapes")
  
  'テキスト追加オリジナル(明朝)
  Set cBarCtrl = cBar.Controls.Add(Type:=msoControlButton _
                  , Before:=6)
  With cBarCtrl
    .Caption = "テキストの追加 オリジナル(明朝)"
    .OnAction = "AddTextToShape"
    .Visible = True
  End With
  
  'テキスト追加オリジナル(ゴシック)
  Set cBarCtrl2 = cBar.Controls.Add(Type:=msoControlButton _
                  , Before:=7)
  With cBarCtrl2
    .Caption = "テキストの追加 オリジナル(ゴシック)"
    .OnAction = "AddTextToShape2"
    .Visible = True
  End With

End Sub

'==============================================
Sub Auto_Close()
  Application.CommandBars("Shapes").Reset
End Sub

'==============================================
Private Sub AddTextToShape() ’----(1)
'明朝
  Dim shpA As Shape
  Dim charsA As Characters

  On Error Resume Next
  Set shpA = ActiveSheet.Shapes(Selection.Name)
  Set charsA = shpA.TextFrame.Characters
  On Error GoTo 0
  If charsA Is Nothing Then
    MsgBox "この操作は行えません。", vbInformation
    Exit Sub
  End If

  ' シェイプのフォント・書式を設定できるように空文字を入れる
  charsA.Text = ""
  ' シェイプのフォントを設定する
  charsA.Font.Name = "MS 明朝"
  charsA.Font.Size = 11
  ' シェイプの書式を設定する
  shpA.TextFrame.HorizontalAlignment = xlHAlignCenter
  shpA.TextFrame.VerticalAlignment = xlVAlignCenter
  
  Application.ScreenUpdating = False
  ' シェイプ内で文字が打てる状態にする
  SendKeys "{DOWN 5}{ENTER}"
  Application.CommandBars("Shapes").ShowPopup
  Application.ScreenUpdating = True
End Sub

'==============================================
Private Sub AddTextToShape2() ’----(2)
'ゴシック
  Dim shpA As Shape
  Dim charsA As Characters

  On Error Resume Next
  Set shpA = ActiveSheet.Shapes(Selection.Name)
  Set charsA = shpA.TextFrame.Characters
  On Error GoTo 0
  If charsA Is Nothing Then
    MsgBox "この操作は行えません。", vbInformation
    Exit Sub
  End If

  ' シェイプのフォント・書式を設定できるように空文字を入れる
  charsA.Text = ""
  ' シェイプのフォントを設定する
  charsA.Font.Name = "MS ゴシック"
  charsA.Font.Size = 11
  ' シェイプの書式を設定する
  shpA.TextFrame.HorizontalAlignment = xlHAlignCenter
  shpA.TextFrame.VerticalAlignment = xlVAlignCenter
  
  Application.ScreenUpdating = False
  ' シェイプ内で文字が打てる状態にする
  SendKeys "{DOWN 5}{ENTER}"
  Application.CommandBars("Shapes").ShowPopup
  Application.ScreenUpdating = True
End Sub

'==============================================

これで、標準にある「テキストの追加」の上に「テキストの追加 オリジナル(明朝)」「テキストの追加 オリジナル(ゴシック)」のメニューが追加されたわけですが・・・・

これを実行すると、何故か「明朝」を選択したときに「ゴシック」になり、「ゴシック」を選択したときは「明朝」になってしまいます(>_<)

なんで〜〜〜〜?

と、いういことで、(1)と(2)のところ「ブレイクポイント」を置いて実行してみました。
ステップ実行で一行ずつ実行していくと、正常に動くようです。(明朝なら明朝に・・・)
でも、「明朝」を選択し(1)で止まったところで、「実行」ボタンで続けさせると、何故かつづけて(2)へ進んでいるようです。
同じように、「ゴシック」を選択すると(2)から(1)へ進んでしまいます。

なので、結果的に、選択したのと逆の結果になったんですね。

そこまではわかったのですが、そうなる原因がわかりません。
なんでそんな奇っ怪(私にとっては・・・)なことを起こるのでしょうか?

よろしくお願いしますm(__)m

0 hits

【61844】図形の右クリックメニューに登録したマクロ(テキスト追加) つん 09/6/9(火) 12:45 質問
【61847】Re:図形の右クリックメニューに登録したマ... kanabun 09/6/9(火) 13:12 発言
【61849】Re:図形の右クリックメニューに登録したマ... つん 09/6/9(火) 13:43 お礼
【61850】Re:図形の右クリックメニューに登録したマ... kanabun 09/6/9(火) 13:57 発言
【61856】Re:図形の右クリックメニューに登録したマ... つん 09/6/9(火) 14:28 お礼
【61855】Re:図形の右クリックメニューに登録したマ... n 09/6/9(火) 14:21 発言
【61858】Re:図形の右クリックメニューに登録したマ... つん 09/6/9(火) 14:40 お礼
【61859】Re:図形の右クリックメニューに登録したマ... n 09/6/9(火) 16:12 発言
【61865】Re:図形の右クリックメニューに登録したマ... つん 09/6/9(火) 17:05 お礼
【61867】Re:図形の右クリックメニューに登録したマ... n 09/6/9(火) 20:53 発言
【61868】Re:図形の右クリックメニューに登録したマ... n 09/6/9(火) 21:19 発言
【61875】Re:図形の右クリックメニューに登録したマ... つん 09/6/10(水) 9:07 発言
【61874】Re:図形の右クリックメニューに登録したマ... つん 09/6/10(水) 9:01 発言
【61877】Re:図形の右クリックメニューに登録したマ... つん 09/6/10(水) 9:57 発言

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