Results of 1 - 1 of about 28 for 平均 平日 (0.001 sec.)
平均 (1366), 平日 (459)
- [[20100519102843]]
- #score: 10343
- @digest: 2d2f511ee3989b61970980fa0d3481af
- @id: 49511
- @mdate: 2010-05-24T02:56:48Z
- @size: 12969
- @type: text/plain
- #keywords: kanshi (47412), pointapi (18361), poi (17562), getcursorpos (15085), ト編 (12418), シェ (10387), ェイ (9784), 集中 (8492), トシ (8283), 監視 (8087), イプ (7248), userform1 (7010), declare (5066), 編集 (4147), sleep (3953), テキ (3553), キス (3284), オー (3133), モー (2916), doevents (2400), ーフ (2297), private (2141), activecell (2134), ichinose (2066), ラベ (1947), inputbox (1932), commandbutton1 (1582), イベ (1546), ォー (1526), ボタ (1525), ベル (1408), フォ (1407)
- 『オートシェイプのテキスト編集中』（ところ）
Excelシート上にユーザーフォームを.Show vbModelessで表示したまま、 シート上を操作するプログラムを組んでいますが、シート上のオートシェイプに テキストがあり、このテキストを編集中には、ユーザーフォームのボタンが受け 付けられません。 ESCキーを押す、または、セルをクリックすれば良いのですが、これらの操作を せずにユーザーフォームのボタンをクリック出来る、他に良い方法はないでしょうか? 宜しくお願い致します。 ---- オブジェクトのテキスト編集中はマクロは動作しません。 イベントも起動しないのでMouse_Moveイベントすら使えません。 なので、逆にシェイプに文字を入れる事をVBAで制御してはどうでしょうか? たとえば Sub SetText() ActiveSheet.DrawingObjects(Application.Caller).Text = InputBox("入力") End Sub こんなコードを標準モジュールに入れておいて シェイプにマクロ登録で上のプロシージャを登録します。 その状態でModelessのフォームを起動した状態でシェイプをクリックすると InputBoxで文字が入力できますし、確実にInputBoxを終了させられるので フォームもそのまま使えると思います。 こんな代替案はいかがですか? （momo） ---- 一例ですが、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 = "MS Pゴシック" .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なのでこれらを工夫して、もっと他に良い仕様が 思いつけばよいのですが・・・・。 ユーザーフォームのモーダレスでの運用はいろいろな意味で難しいですね!! だからって、上記をモーダルにして、全部VBAでやってしまおうとすると、これもまた大変だしね!! 何かの参考になれば・・・・。 ichinose ---- momoさんありがとうございます。 試してみましたら、確かに便利です。 ただ通常の編集にも入れるので、完璧とまでいきませんでした。 編集に入りたいは、ある時は入れなくていいわでちょっと 条件がごちゃになってます。ので ほかに方法が見つからなければ、これが最適になりそうです。 ichinoseさんありがとうございます。 まだ試せてませんので、あとでご報告させていただきます。 （ところ） ---- 条件によっては色々可能ですけどね。 たとえば、UserForm1が表示されている時だけシェイプの編集を可能にするなら Sub SetText() If UserForm1.Visible = True Then ActiveSheet.DrawingObjects(Application.Caller).Text = InputBox("入力") End If End Sub こんな風に判定してあげればいいですし。 （momo） ---- ichinoseさん大変お世話になります。 拝見させていただきました。 SendKeys " {BS}" で 書き込み出来ません。 とエラーします。 わからないので、コメントアウトして動かしてみましたら、動作概要はわかりました。 自分で変更何とかならないかと少し試しましたが、とても変更出来るレベルではありませんでした。 そこで大変申し訳ないのですが、こんな仕様で作っていただくわけにはいきませんか? ・オートシェイプは既に複数作成されている状態でこれらを編集します。 ・いずれかのオートシェイプを編集している時に、ユーザーフォームにカーソルが行くと編集モードから抜けたい。 （出来ればescキーを送信するイメージ）オートシェイプは、文字編集出来ても、サイズが変更出来なくロックされているものも存在するから。 ・オートシェイプの文字編集のタイミングは、ありませんが、もしタイミングが必要であれば、ユーザーフォームにボタン追加等してもいいです。 (ところ) ---- momoさん大変ありがとうございます。 momoさんので確かにいけそうなのですが、ちょっと変な事情があるんです。 こちらを先に話すべきだったと反省してます。 ・とても大きいイメージファイルが張り付いていて、その上に、テキストの書き込める、オートシェイプがいくつも乗っています。 ・このオートシェイプは、文字のみ書き込める様にロックされています。 つまりこのファイルに文字のみ書き込む人は、escキーを押さない限り文字編集モードから抜けられない。 セルは、セレクト出来なくしてます。セレクト出来る様にしたとしても、下絵のイメージファイルが大きすぎて選択に面倒です。 （だったらescキーを押す様に促すだけでいいだろと言われそうですが） また、 上記のファイルには、マクロは一切入っていませんが、このファイルを作るエクセルブックが別にありまして、このブックの操作をしている最中にも オートシェイプの編集モードから抜けだしにくいと言う問題があります。 さらにこのブックを触っている時は、オートシェイプの文字フォントとかも触るので とか、いろいろありまして。 （だったらescキーを押す様に促すだけでいいだろと言われそうですが） escキーを押すと言うこともわかりにくいと言われてまして。 こんな感じの状況です。 （ところ） ---- フォントなども変更するのですか・・・ 文字だけなら、たとえばテキスト部分だけをコントロールのラベルなんかを使って MouseMoveイベントやMouseUpイベントでInputBoxで入力させる。なんて事をすれば マクロの動作を止めずに出来るかな〜とか思ってみたのですが、お役に立てずすみません。 （momo） ---- >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さん動かしてみました。 希望通りに動作致しました。大変有り難う御座います。 確かにおっしゃる通り図形には、編集中がわかりにくいですが、ラベルを強調 表示することでしっかりわかります。 大変お世話になりました。 momoさんも大変有り難う御座いました。 （ところ）... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201005/20100519102843.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97032 documents and 608010 words.
訪問者：