[[20100519102843]]　『オートシェイプのテキスト編集中』（ところ）　ページの最後に飛ぶ

『オートシェイプのテキスト編集中』（ところ）

 Excelシート上にユーザーフォームを.Show vbModelessで表示したまま、
 シート上を操作するプログラムを組んでいますが、シート上のオートシェイプに
 テキストがあり、このテキストを編集中には、ユーザーフォームのボタンが受け
 付けられません。
 ESCキーを押す、または、セルをクリックすれば良いのですが、これらの操作を
 せずにユーザーフォームのボタンをクリック出来る、他に良い方法はないでしょうか？
 宜しくお願い致します。

 オブジェクトのテキスト編集中はマクロは動作しません。
 イベントも起動しないのでMouse_Moveイベントすら使えません。

 なので、逆にシェイプに文字を入れる事をVBAで制御してはどうでしょうか？

 たとえば
  Sub SetText()
  ActiveSheet.DrawingObjects(Application.Caller).Text = InputBox("入力")
  End Sub
 こんなコードを標準モジュールに入れておいて
 シェイプにマクロ登録で上のプロシージャを登録します。

 その状態でModelessのフォームを起動した状態でシェイプをクリックすると
 InputBoxで文字が入力できますし、確実にInputBoxを終了させられるので
 フォームもそのまま使えると思います。

 こんな代替案はいかがですか？
 （ｍｏｍｏ）

 一例ですが、APIのGetCursorPosを使ってカーソル位置を監視する方法です。
 新規ブックにて試してください。

 ユーザーフォームを一つ作成してください（UserForm1）
     UserForm1には、コマンドボタンを二つ用意して下さい。

     CommandButton1　　------　　テキストボックス編集中にクリックするボタン
     CommandButton2　　------　　テキストボックス作成し、テキストの編集を行う

 UserForm1のモジュールに

 '==============================================================================
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Private Declare Function SetCursorPos Lib "USER32" (ByVal x As Long, ByVal y As Long) As Long
 Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
 Private Type POINTAPI
   x As Long
   y As Long
 End Type
 '===============================================================================
 Private Sub CommandButton1_Click()
    MsgBox "コマンドボタンが押せました"
 End Sub
 '===============================================================================
 Private Sub CommandButton2_Click()
    SetCursorPos ActiveCell.Left * 96 / 72 - 5, ActiveCell.Top * 96 / 72 - 5
    Me.Left = ActiveCell.Left + ActiveWindow.PointsToScreenPixelsX(0) * 72 / 96 + 30
    Me.Top = ActiveCell.Top + ActiveWindow.PointsToScreenPixelsY(0) * 72 / 96 + 30
    mk_textbox
 End Sub
 '===============================================================================
 Sub mk_textbox()
    Dim vLeft, vtop, vHeight, vWidth As Long
    Dim txt As String
    Dim svx As Double, svy As Double
    Dim Poi As POINTAPI
    AppActivate Application.Caption
    DoEvents
    With ActiveCell '位置調整
        vLeft = .Left
        vtop = .Top
        vHeight = .Height
        vWidth = .Width
    End With
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, vLeft, vtop, vWidth, vHeight)
       .Fill.ForeColor.RGB = RGB(255, 204, 204)
       With .TextFrame
          With .Characters
             .Text = ""
             With .Font
                .Name = "ＭＳ Ｐゴシック"
                .Size = 8
                End With

             End With
          End With
       .Select
       SendKeys " {BS}"
       On Error Resume Next
       Do While Selection.Name = .Name
          If Err.Number <> 0 Then Exit Do
          Call GetCursorPos(Poi)
          With UserForm1
             If Poi.x * 72 / 96 >= .Left And Poi.y * 72 / 96 >= .Top Then
                If Poi.x * 72 / 96 <= .Left + .Width And Poi.y * 72 / 96 <= .Top + .Height Then
                   ActiveCell.Activate
                   Exit Do
                End If
              End If
          End With
          DoEvents
          Sleep 100
       Loop
       On Error GoTo 0
       .TextFrame.AutoSize = True
       End With
 End Sub

 標準モジュールに
 Sub test()
    UserForm1.Show vbModeless
 End Sub

 testを実行してみてください。

 UserForm1が表示されます。
 CommandButton2をクリックしてみてください。
 アクティブセル付近にテキストボックスが作成され、テキスト編集状態になっています。
 適当にテキストを入力してください。編集終了後、直接CommanduButton1をクリックしてみてください。
 マウスカーソルがUserForm1の領域に入ると、テキスト編集が終了するので、
 CommanduButton1のクリックが可能になります。

 これは、あくまでも一例です。簡単なAPIなのでこれらを工夫して、もっと他に良い仕様が
 思いつけばよいのですが・・・・。

 ユーザーフォームのモーダレスでの運用はいろいろな意味で難しいですね！！
 だからって、上記をモーダルにして、全部ＶＢＡでやってしまおうとすると、これもまた大変だしね！！

 何かの参考になれば・・・・。

 ichinose

 ｍｏｍｏさんありがとうございます。
 試してみましたら、確かに便利です。
 ただ通常の編集にも入れるので、完璧とまでいきませんでした。
 編集に入りたいは、ある時は入れなくていいわでちょっと
 条件がごちゃになってます。ので
 ほかに方法が見つからなければ、これが最適になりそうです。

 ichinoseさんありがとうございます。
 まだ試せてませんので、あとでご報告させていただきます。
 （ところ）

 条件によっては色々可能ですけどね。

 たとえば、UserForm1が表示されている時だけシェイプの編集を可能にするなら

  Sub SetText()
  If UserForm1.Visible = True Then
      ActiveSheet.DrawingObjects(Application.Caller).Text = InputBox("入力")
  End If
  End Sub

 こんな風に判定してあげればいいですし。

 （ｍｏｍｏ）

 ichinoseさん大変お世話になります。
 拝見させていただきました。
 SendKeys " {BS}"
 で　書き込み出来ません。　とエラーします。
 わからないので、コメントアウトして動かしてみましたら、動作概要はわかりました。

 自分で変更何とかならないかと少し試しましたが、とても変更出来るレベルではありませんでした。
 そこで大変申し訳ないのですが、こんな仕様で作っていただくわけにはいきませんか？

 ・オートシェイプは既に複数作成されている状態でこれらを編集します。
 ・いずれかのオートシェイプを編集している時に、ユーザーフォームにカーソルが行くと編集モードから抜けたい。
 　（出来ればescキーを送信するイメージ）オートシェイプは、文字編集出来ても、サイズが変更出来なくロックされているものも存在するから。
 ・オートシェイプの文字編集のタイミングは、ありませんが、もしタイミングが必要であれば、ユーザーフォームにボタン追加等してもいいです。

(ところ)

ｍｏｍｏさん大変ありがとうございます。

 ｍｏｍｏさんので確かにいけそうなのですが、ちょっと変な事情があるんです。
 こちらを先に話すべきだったと反省してます。
 ・とても大きいイメージファイルが張り付いていて、その上に、テキストの書き込める、オートシェイプがいくつも乗っています。
 ・このオートシェイプは、文字のみ書き込める様にロックされています。
 つまりこのファイルに文字のみ書き込む人は、escキーを押さない限り文字編集モードから抜けられない。
 セルは、セレクト出来なくしてます。セレクト出来る様にしたとしても、下絵のイメージファイルが大きすぎて選択に面倒です。
 （だったらescキーを押す様に促すだけでいいだろと言われそうですが）

 また、
 上記のファイルには、マクロは一切入っていませんが、このファイルを作るエクセルブックが別にありまして、このブックの操作をしている最中にも
 オートシェイプの編集モードから抜けだしにくいと言う問題があります。
 さらにこのブックを触っている時は、オートシェイプの文字フォントとかも触るので
 とか、いろいろありまして。
 （だったらescキーを押す様に促すだけでいいだろと言われそうですが）
 escキーを押すと言うこともわかりにくいと言われてまして。
 こんな感じの状況です。
 （ところ）

 フォントなども変更するのですか・・・
 文字だけなら、たとえばテキスト部分だけをコントロールのラベルなんかを使って
 MouseMoveイベントやMouseUpイベントでInputBoxで入力させる。なんて事をすれば
 マクロの動作を止めずに出来るかな～とか思ってみたのですが、お役に立てずすみません。
 （ｍｏｍｏ）

 >SendKeys " {BS}"
 >で　書き込み出来ません。　とエラーします。
 何でだろう？ excel2002では、正常に作動していますけどね！！

 ちょっと仕様を変えます。

 新規ブックにて、以下の標準モジュールのsample_autoshapeを実行し、サンプル的なオートシェイプを作成します。

 sample_autoshapeにて作成されたオートシェイプには、select_shpというマクロを登録してあります。

 '===============================================================================
 Sub sample_autoshape()
    With ActiveSheet
       With .Shapes.AddShape(msoShapeRectangle, 114#, 89.25, 142.5, 39.75)
           .OnAction = "select_shp"
       End With
       With .Shapes.AddShape(msoShapeOval, 369#, 78#, 129.75, 41.25)
            .OnAction = "select_shp"
       End With
       With .Shapes.AddShape(msoShapeExplosion2, 378.75, 183#, 221.25, 57.75)
            .OnAction = "select_shp"
       End With
    End With
 End Sub
 '==================================================================================== 
 Sub select_shp()
    ActiveSheet.Shapes(Application.Caller).Select
 End Sub

 これでサンプルオートシェイプが作成できました。

 次にユーザーフォームを一つ作成してください（UserForm1）
     UserForm1には、コマンドボタンとラベルをひとつずつ作成してください。

     CommandButton1　　------　　テキストボックス編集中にクリックするボタン　テスト用
     Label1        　　------　　選択されたオートシェイプの名前がを選択中は表示する

 では、コードです。

 クラスモジュールを作成してください（Class1）。

 '==========================================================================
 Option Explicit
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Event selectshape(obj As Shape)
 Public kanshi As Boolean 'true 監視中 false 監視中止
 Sub exec_kanshi(typ As MsoShapeType) 'Shapeオブジェクトの選択を監視する
    kanshi = True
    Dim obj As Object
    Dim shps As ShapeRange
    On Error Resume Next
    Do While kanshi
       Err.Clear
       Set obj = Selection
       Set shps = obj.ShapeRange
       If Err.Number = 0 Then
          If shps.Count = 1 Then
             If shps(1).Type = typ Then
                RaiseEvent selectshape(shps(1)) 'イベント
             End If
          End If
       End If
       Sleep 10
       DoEvents
    Loop
 End Sub

 次にUserForm1のモジュール

 '=============================================================================
 Option Explicit
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Private Declare Function SetCursorPos Lib "USER32" (ByVal x As Long, ByVal y As Long) As Long
 Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
 Private Type POINTAPI
   x As Long
   y As Long
 End Type
 Private WithEvents kanshi As Class1
 Private Sub CommandButton1_Click()  'テスト用ボタン
    MsgBox "ボタン1が押された"
 End Sub
 '=============================================================================
 Private Sub kanshi_selectshape(obj As Shape)
    Dim Poi As POINTAPI
    On Error Resume Next
    Label1.Caption = "オートシェイプ  " & obj.Name & "  編集中です"
    Do While Selection.Name = obj.Name
       If Err.Number <> 0 Then Exit Do
       Call GetCursorPos(Poi)
       With Me
          If Poi.x * 72 / 96 >= .Left And Poi.y * 72 / 96 >= .Top Then
             If Poi.x * 72 / 96 <= .Left + .Width And Poi.y * 72 / 96 <= .Top + .Height Then
                ActiveCell.Activate
             End If
          End If
       End With
       DoEvents
       Sleep 100
    Loop
    Label1.Caption = ""
    On Error GoTo 0
 End Sub
 '=============================================================================
 Private Sub UserForm_activate()
    Set kanshi = New Class1
    kanshi.exec_kanshi msoAutoShape 'オートシェイプの選択を監視
 End Sub
 '=============================================================================
 Private Sub UserForm_Terminate()
    kanshi.kanshi = False  '監視終了
 End Sub

 最後に標準モジュール（Module2）に

 '=============================================================================
 Sub test()
    UserForm1.Show vbModeless
 End Sub

 一度保存して閉じてから、再度開いて試してください。

 予め作成されているオートシェイプがあるシートをアクティブにして、testを実行してください。

 UserForm1がモードレスモードで表示されます。
 編集したいオートシェイプを選択してください。
 選択が成功すると、Userform1のラベルに選択中のオートシェイプの名前が表示されます。
 但し、通常の図形選択と違い、選択していることがわかりづらいです（そのためにラベルに表示しました）

 右クリックメニューを使って、テキスト編集を行ってください。編集途中でUserform1のボタンをクリックしてください。

 ボタンがクリック可能になっています。

 他の機能（文字の大きさなど）も使えますから試してみてください。

 ichinose

 ichinoseさん動かしてみました。
 希望通りに動作致しました。大変有り難う御座います。
 確かにおっしゃる通り図形には、編集中がわかりにくいですが、ラベルを強調
 表示することでしっかりわかります。
 大変お世話になりました。
 ｍｏｍｏさんも大変有り難う御座いました。
（ところ）

コメント返信：

[ 一覧(最新更新順) ]

[[20100519102843]] 『オートシェイプのテキスト編集中』（ところ） ページの最後に飛ぶ

[[20100519102843]]　『オートシェイプのテキスト編集中』（ところ）　ページの最後に飛ぶ