Excel VBA質問箱 IV

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

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


20304 / 76732 ←次へ | 前へ→

【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
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 発言

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