Ｐａｇｅ 342 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼イベントについて ハマゾウ 02/11/10(日) 20:10 ┗Re:イベントについて JuJu 02/11/11(月) 13:00 ┗Re:イベントについて ichinose 02/11/13(水) 8:22 ┗イベントについて ハマゾウ 02/11/14(木) 13:41 ─────────────────────────────────────── ■題名 ： イベントについて ■名前 ： ハマゾウ <hama@mb.town.yatsuo.toyama.jp> ■日付 ： 02/11/10(日) 20:10 ■Ｗｅｂ ： http://www.cty8.com/nsha3921/Home/index.htm -------------------------------------------------------------------------
| WorkSheet上の図形（たとえば、矢印やテキストボックスなど）の移動、サイズ変更時にイベントを発生させえることは可能でしょうか？ ご存知の方、ご教授願います。 |
| ハマゾウさん、こんにちはぁ >WorkSheet上の図形（たとえば、矢印やテキストボックスなど）の移動、サイズ変更時にイベントを発生させえることは可能でしょうか？ Excelでは、オートシェイプの移動等のイベントを取ることはできません。 （Visioは可能だったかな） 私は、Excel2000しか使っていないので最近のバージョンでは未確認です。 多分、変わっていないと思います。 ではではぁ |
| ▼JuJu さん： ハマゾウさん。 おはようございます。 >>WorkSheet上の図形（たとえば、矢印やテキストボックスなど）の移動、サイズ変更時にイベントを発生させえることは可能でしょうか？ Excel2000以降で､条件付なんですが､イベントを作ってみました。 オートシェイプ又は､テキスト ボックスが最低ひとつあるシートが対象ですし、 以下のコードは､オブジェクトの追加・削除については考えていませんが､ クラスモジュールを二つ作成します。 Class1モジュールに、 '============================================================ Public Event resize(ByVal shp As Shape) Private flg As Boolean Private shp() As Shape Private Type info top As Double left As Double width As Double height As Double End Type Private aridx As Long Private shpinfo() As info '=================================================== Sub shpp(dat1 As Shape) ReDim Preserve shp(aridx) Set shp(aridx) = dat1 ReDim Preserve shpinfo(aridx) Call set_info(aridx) aridx = aridx + 1 End Sub '=================================================== Property Let flag(dat2 As Boolean) flg = dat2 End Property '=================================================== Property Get flag() As Boolean flag = flg End Property '=================================================== Private Sub set_info(idx As Long) With shpinfo(idx) .top = shp(idx).top .left = shp(idx).left .width = shp(idx).width .height = shp(idx).height End With End Sub '=================================================== Sub 監視() 'このプロシジャーで図形の移動変更を監視する Dim chk As Long Dim idx As Long chk = 0 Do While flg = True For idx = LBound(shp()) To UBound(shp()) chk = chk_shp(idx) If chk = 1 Then RaiseEvent resize(shp(idx)) End If DoEvents Next idx Loop End Sub '=================================================== Function chk_shp(idx As Long) As Long On Error Resume Next Err.Clear chk_shp = 0 With shpinfo(idx) If .top <> shp(idx).top Or .left <> shp(idx).left Or .height <> shp(idx).height Or .width <> shp(idx).width Then chk_shp = 1 Call set_info(idx) End If End With If Err.Number <> 0 Then chk_shp = 2 End If On Error GoTo 0 End Function '=================================================== Private Sub Class_Initialize() aridx = 0 End Sub Class2モジュールで、 '=================================================== Public WithEvents cls1 As Class1 Private Sub Class_Initialize() Set cls1 = New Class1 End Sub '=================================================== Private Sub Class_Terminate() Set cls1 = Nothing End Sub '=================================================== Private Sub cls1_resize(ByVal shp As Shape) MsgBox shp.Name & "が変更された" 'ここに、サイズ変更時のコード記述 End Sub 後は､適当な場所でインスタンスを作成するのですが､例はThisworkbookモジュールで '=================================================== Private Sub Workbook_BeforeClose(Cancel As Boolean) shps.cls1.flag = False Set shps = Nothing End Sub '=================================================== Private Sub Workbook_Open() Dim sh As Shape Set shps = New Class2 i = 0 For Each sh In Worksheets(1).Shapes shps.cls1.shpp dat1:=sh Next shps.cls1.flag = True shps.cls1.監視 End Sub オートシェイプを監視するシートモジュール（Worksheet(1)）で、 '==================================================== Private Sub Worksheet_Activate() shps.cls1.flag = False shps.cls1.flag = True shps.cls1.監視 End Sub '==================================================== Private Sub Worksheet_Deactivate() shps.cls1.flag = False End Sub 最後に標準モジュールで '==================================================== Public shps As Class2 尚､サイズの変更は、右クリックの書式設定でしか出来ませんでした。 |
| ichinoseさん はずかしながら、コードの内容は理解できていないのですが イベントが発生することは確認できました。 どうもありがとうございました。 |