Excel VBA質問箱 IV

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

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


3493 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

【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

【61847】Re:図形の右クリックメニューに登録した...
発言  kanabun  - 09/6/9(火) 13:12 -

引用なし
パスワード
   ▼つん さん:
>こんにちは^^

2つのプロシージャ内の ↓の部分が注目したい行ではないでしょうか?
とくに、SendKeys したキーボードストロークがどこに伝えられているの
かが分かると。
  
>  ' シェイプ内で文字が打てる状態にする
>  SendKeys "{DOWN 5}{ENTER}"
>  Application.CommandBars("Shapes").ShowPopup

【61849】Re:図形の右クリックメニューに登録した...
お礼  つん  - 09/6/9(火) 13:43 -

引用なし
パスワード
   ▼kanabun さん
回答ありがとうございました!(^o^)

>2つのプロシージャ内の ↓の部分が注目したい行ではないでしょうか?
>とくに、SendKeys したキーボードストロークがどこに伝えられているの
>かが分かると。
>  
>>  ' シェイプ内で文字が打てる状態にする
>>  SendKeys "{DOWN 5}{ENTER}"
>>  Application.CommandBars("Shapes").ShowPopup

注目したいところは私が一番理解できてなかった所でしたorz
特に
SendKeys "{DOWN 5}{ENTER}"
は、「よくわからんけど、とにかく編集モードにしてるんやな」程度でございました^^;


わかりました(^o^)ノ
右クリックメニューの「テキストの編集」を選択してたわけですね。
それが、一つメニューが加わることによって、ずれちゃった・・と、いうことですね。


ということで、

SendKeys "{DOWN 6}{ENTER}"

で、正しい動作をしてくれるようになりました\(^o^)/
ありがとうございました!


でもでも、

なんで「ステップ実行」のときは(2)あるいは(1)へ進まなかったのか?

右クリックメニューの4番目ににある「明朝」を選択したときは、「ゴシック」へ進んでしまうのはわかるけど、「ゴシック」を選択したときに「明朝」……一つ上のメニューなのに……になるのは理解できませんorz

【61850】Re:図形の右クリックメニューに登録した...
発言  kanabun  - 09/6/9(火) 13:57 -

引用なし
パスワード
   ▼つん さん:

>注目したいところは私が一番理解できてなかった所でしたorz
>
>SendKeys "{DOWN 6}{ENTER}"
>
>で、正しい動作をしてくれるようになりました\(^o^)/

いまこちらで検証してみましたが、
不具合は起こらず、どういう連鎖反応が起きているのか調べきれませんでした。
スミマセン。
(SendKeys というのは ステップ実行して確かめれないからやっかいですね)

ところで
話は代わりますが、
OnActionの実行先プロシージャでちがうところはフォントが「明朝」か
「ゴチック」かのちがいだけですか?

そうであれば、1つのプロシージャをパラメータを変えて呼び出すことで
コードがもっと簡単になりメンテナンスしやすくなると思います。

Sub Auto_Open()
  Dim cBar As Office.CommandBar

  Call Reset_ShapesMenu
  Set cBar = Application.CommandBars("Shapes")

  'テキスト追加オリジナル(明朝)
  With cBar.Controls.Add(Type:=msoControlButton _
                  , Before:=6)
    .Caption = "テキストの追加 (明朝)"
    .OnAction = "AddTextToShape"
    .Parameter = 1   '◆追加
    .Visible = True
  End With

  'テキスト追加オリジナル(ゴシック)
  With cBar.Controls.Add(Type:=msoControlButton _
                  , Before:=7)
    .Caption = "テキストの追加 (ゴシック)"
    .OnAction = "AddTextToShape"  '◆上と同じプロシージャ名
    .Parameter = 2   '◆追加
    .Visible = True
  End With

End Sub

'Sub Auto_Close() 省略

Private Sub AddTextToShape() '----(1)
  Dim FontName As String       '-------- ◆ここから
  Dim i As Long
  i = CommandBars.ActionControl.Parameter
  Select Case i
   Case 1: FontName = "MS 明朝"
   Case 2: FontName = "MS ゴシック"
   Case Else
       Exit Sub
  End Select  '-------------------------------- ◆ここまで挿入
  
  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 = FontName   '◆ 変更
  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

【61855】Re:図形の右クリックメニューに登録した...
発言  n  - 09/6/9(火) 14:21 -

引用なし
パスワード
   バージョンによって違うのでしょうか。
Excel2000ではご提示コードで正常動作します。
仮に「テキストの編集」しなくてもキーを打てば編集状態になるようなんですが、
何らかの対策があるのでしょうね。

2000では、代わりに
SendKeys "x"
っていうのでもできるようです?

それとか
>Application.ScreenUpdating = False
>' シェイプ内で文字が打てる状態にする
>SendKeys "{DOWN 5}{ENTER}"
>Application.CommandBars("Shapes").ShowPopup
>Application.ScreenUpdating = True
に代えて
Application.CommandBars.FindControl(ID:=1401).accDoDefaultAction
とか。

【61856】Re:図形の右クリックメニューに登録した...
お礼  つん  - 09/6/9(火) 14:28 -

引用なし
パスワード
   ▼kanabun さん:

>いまこちらで検証してみましたが、
>不具合は起こらず、どういう連鎖反応が起きているのか調べきれませんでした。
>スミマセン。

いえ、とんでもないです。
お手数をおかけしました。ありがとうございます^^

>(SendKeys というのは ステップ実行して確かめれないからやっかいですね)

実は、Sendkeysって自分では使ったことがなく、ステップ実行で妙な動き(しばらく止まってしまう)で戸惑ってしまいました。

>ところで
>話は代わりますが、
>OnActionの実行先プロシージャでちがうところはフォントが「明朝」か
>「ゴチック」かのちがいだけですか?

そうです。人に、「明朝」で作ってもらって便利に使ってたのを、最近必要性が出てきて、突貫的に「ゴシック」バージョンも作ってくっつけたって感じです。


>そうであれば、1つのプロシージャをパラメータを変えて呼び出すことで
>コードがもっと簡単になりメンテナンスしやすくなると思います。

ありがとうございました(^o^)ノ
提示していただいたコードに差し替えてみました。
コードはすっきりして、実行結果もバッチシで、大満足です\(^o^)/

「Parameter プロパティ」も恥ずかしながら使ったことがなかったです。
ヘルプを見てもイマイチピンとこないですねーー;
これをとっかかりに、自分でも自在に使えるようになりたいです。

ありがとうございました^^

なんか、久しぶりに質問でちょい緊張してたんやけど、
質問して良かったですw


あ、そうそう!

SendKeys "{DOWN 6}{ENTER}"

の部分は、やはり「6」で正解のようです。
「5」のままだと、また、Parameterの値が変わって、
再び、「AddTextToShape」が実行されるようでした。

【61858】Re:図形の右クリックメニューに登録した...
お礼  つん  - 09/6/9(火) 14:40 -

引用なし
パスワード
   ▼n さん
コメントありがとうございます!

>バージョンによって違うのでしょうか。
>Excel2000ではご提示コードで正常動作します。
あ・・・そうなんですか・・・
うちは、2003です。
家に、2007があるから、持って帰って試してみようかなあ・・・

>2000では、代わりに
>SendKeys "x"
>っていうのでもできるようです?

試してみました。OKでした!
「x」ってなんじゃい?・・って思ったら、「テキストの編集」のショートカットキーですね^^
これのほうが、メニューが上から何番目か?・・・なんて関係ないからいいかも。


>>Application.ScreenUpdating = False
>>' シェイプ内で文字が打てる状態にする
>>SendKeys "{DOWN 5}{ENTER}"
>>Application.CommandBars("Shapes").ShowPopup
>>Application.ScreenUpdating = True
>に代えて
>Application.CommandBars.FindControl(ID:=1401).accDoDefaultAction
>とか。

こちらも試してOKでした。
ただ・・・・
Application.CommandBars.FindControl(ID:=1401).accDoDefaultAction
の意味がわからないorz
「accDoDefaultAction」がヘルプに拒否されましたorz
今回は、kanabunさんのコードと「SendKeys "x"」の合わせ技で行こうかな・・と思いますが、「accDoDefaultAction」の意味も、教えていただけたら幸いです。
お手すきの時で十分ですので、よろしくお願いします。

【61859】Re:図形の右クリックメニューに登録した...
発言  n  - 09/6/9(火) 16:12 -

引用なし
パスワード
   [オブジェクトブラウザ]を表示させて、そのウィンドウ内で右クリック[非表示のメンバの表示]に
チェックを入れると[オブジェクトブラウザ]内検索で出てきます。
『Office.IAccessible のメンバ』
非表示メンバを表示させておくとコード入力時の[入力候補]にグレー文字でリストアップされます。
文献としては
『Microsoft Active Accessibility V2.0』
//msdn.microsoft.com/ja-jp/library/cc421916.aspx
ここ以下
//msdn.microsoft.com/ja-jp/library/cc402055.aspx
などでしょうか。

専門的な事となるとは私もかなりアヤしくなりますが
Active Accessibility『障害のある人がコンピュータをより効果的に使えるようにする特殊なプログラム』として開発されたもので、
その中のIAccessible COMインターフェイスにUI (User Interface) 要素を操作するメソッドがあるとの事です。
で、IAccessible.accDoDefaultAction メソッドは 指定したオブジェクトの既定のアクションを実行します。
今回の場合は CommandBarControl です。
[テキストの編集]コントロールをクリックする動作は
Application.CommandBars.FindControl(ID:=1401).Execute
でもできますので、これを使ってもいいかと思います。
ただ、ExecuteメソッドよりもaccDoDefaultAction メソッドのほうが確実だと読んだ記憶があります。

【61865】Re:図形の右クリックメニューに登録した...
お礼  つん  - 09/6/9(火) 17:05 -

引用なし
パスワード
   ▼n さん
丁寧な解説ありがとうございました^^

ただ・・・・私の、お粗末な頭脳と知識では、ちとついて行きかねましたorz

>で、IAccessible.accDoDefaultAction メソッドは 指定したオブジェクトの既定のアクションを実行します。

この部分だけど、うっすらとわかるようなわからないような・・・
つまり、
CommandBars.FindControl(ID:=1401)
の規定のアクションが「テキスト編集」ってことなんですよね????

ああ・・・せっかく、教えてくださったのに、理解の追いつかない生徒で申し訳ないです。

【61867】Re:図形の右クリックメニューに登録した...
発言  n  - 09/6/9(火) 20:53 -

引用なし
パスワード
   >CommandBars.FindControl(ID:=1401)
>の規定のアクションが「テキスト編集」ってことなんですよね????
そ、そんなに4つもつけなくても^ ^;
概ねそんな理解でいいのでは。

ID:=1401で指定してFindControlメソッドで探したCommandBarControlが[テキストの編集]コントロールです。
簡単に言えば、accDoDefaultActionを使ってこのコントロールをクリックするという事です。

【61868】Re:図形の右クリックメニューに登録した...
発言  n  - 09/6/9(火) 21:19 -

引用なし
パスワード
   それから、2003の場合は
Sub test()
  Dim c As CommandBarControl
  
  For Each c In Application.CommandBars("Shapes").Controls
    Debug.Print c.Index, c.Caption
  Next
End Sub
こんなので確認してみると、デフォルトで

1      切り取り(&T)
2      コピー(&C)
3      インクをテキストとしてコピー(&T)  【出てこん?】
4      貼り付け(&P)
5      再変換(&V)
6      テキストの追加(&X)
7      グループ化(&G)
:
こんなです。
『インク...』って何よ?...な感じですが取りあえず

'テキスト追加オリジナル(明朝)
Set cBarCtrl = cBar.Controls.Add(Type:=msoControlButton _
                , Before:=7)
':
'テキスト追加オリジナル(ゴシック)
Set cBarCtrl2 = cBar.Controls.Add(Type:=msoControlButton _
                , Before:=8)
':
それぞれBefore:=7、8 として[テキストの追加]の後に追加したほうが良いようです。
この場合
SendKeys "{DOWN 5}{ENTER}"
です。

【61874】Re:図形の右クリックメニューに登録した...
発言  つん  - 09/6/10(水) 9:01 -

引用なし
パスワード
   ▼n さん
おはようございます^^

>>CommandBars.FindControl(ID:=1401)
>>の規定のアクションが「テキスト編集」ってことなんですよね????
>そ、そんなに4つもつけなくても^ ^;
>概ねそんな理解でいいのでは。

いや・・・「?」の数で私の自信のなさを読み取ってもらおうと思って^^;;

>ID:=1401で指定してFindControlメソッドで探したCommandBarControlが[テキストの編集]コントロールです。
>簡単に言えば、accDoDefaultActionを使ってこのコントロールをクリックするという事です。

だいぶ納得できました^^
ID:=1401・・・こういうID番号って、どこで調べはるんですか?
カラーインデックスなんかだったら、マクロの記録で調べられますが・・・
リスト表にしているようなサイトさんあるかな?
(昨日、時間の合間にちょこっと検索してみたけど、見あたらなかった)

【61875】Re:図形の右クリックメニューに登録した...
発言  つん  - 09/6/10(水) 9:07 -

引用なし
パスワード
   >Sub test()
>  Dim c As CommandBarControl
>  
>  For Each c In Application.CommandBars("Shapes").Controls
>    Debug.Print c.Index, c.Caption
>  Next
>End Sub

家は2007だったので、出社してしてみました。

1      切り取り(&T)
2      コピー(&C)
3      インクをテキストとしてコピー(&T)
4      貼り付け(&P)
5      再変換(&V)
6      テキストの追加 オリジナル(明朝)
7      テキストの追加 オリジナル(ゴシック)
8      テキストの編集(&X)
9      グループ化(&G)


うちの場合はちょっとアレンジしちゃってるので、こんな感じ。
ほんま!「インクを・・・」って出ますね。
実際、右クリックメニュー出してみても、こんなん出ませんがー
「インク」って何よ・・・・? 私も声を大にしていいたい!!
(と言ってると、誰かが答えてくれるもしれんw)


>'テキスト追加オリジナル(明朝)
>Set cBarCtrl = cBar.Controls.Add(Type:=msoControlButton _
>                , Before:=7)
>':
>'テキスト追加オリジナル(ゴシック)
>Set cBarCtrl2 = cBar.Controls.Add(Type:=msoControlButton _
>                , Before:=8)
>':
>それぞれBefore:=7、8 として[テキストの追加]の後に追加したほうが良いようです。
>この場合
>SendKeys "{DOWN 5}{ENTER}"
>です。

あ、そうですね!
標準のメニューをさしおいて、オリジナルメニューを前に出張らせちゃーいけませんね。
おとなしく後ろに控えさせておけば、変に順番が狂わなくて良かったんや^^

【61877】Re:図形の右クリックメニューに登録した...
発言  つん  - 09/6/10(水) 9:57 -

引用なし
パスワード
   >ID:=1401・・・こういうID番号って、どこで調べはるんですか?
>カラーインデックスなんかだったら、マクロの記録で調べられますが・・・
>リスト表にしているようなサイトさんあるかな?
>(昨日、時間の合間にちょこっと検索してみたけど、見あたらなかった)

あ・・・

Sub test()
  Dim c As CommandBarControl
 
  For Each c In Application.CommandBars("Shapes").Controls
    Debug.Print c.Index, c.Caption, c.ID ’←◆これの追加
  Next
End Sub

これで調べられますね^^;

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