次の方法で共有

AccessでイベントプロシージャをWithEventsで追加したら、×ボタンでAccessが強制終了してしまう

Anonymous
2017-02-14T09:09:08+00:00

↓メインのフォームのコードは下記の通りです。

コントロールは、テキストボックス「txtHelp」が一つと、ラベルコントロール「lbl_01」「lbl_02」を配置してあります。これが、2007までは問題なかったんですが、2013になってからは動く事は動くのですが、フォームを閉じる際や、Accessを閉じる際にAccessが強制終了してしまいます。

すみませんが、どなたか対処方をご存じではないでしょうか?

'----------------------------------------------------------------

Option Compare Database

Dim m_clsLabelHelp() As CLabelHelp  'ラベルヘルプ

''開く時イベント

Private Sub Form_Open(Cancel As Integer)

    Dim frmP As Form       '親のフォーム

    Dim txtHelp As TextBox 'テキストボックス

    Set frmP = Me  '自分自身をfrmPに設定

On Error Resume Next

    Do While ERR.Number = 0

        Set frmP = frmP.Parent

    Loop

On Error GoTo Err_Exit

    Set txtHelp = frmP.Controls("txtHelp")

    Dim ctr As Control

    Dim idx As Long

    For Each ctr In Me.Controls

        If ctr.ControlType = acLabel And Left$(ctr.Name, 3) = "lbl" Then

            ReDim Preserve m_clsLabelHelp(idx)        'CLabelHelpクラスを保持する配列を宣言

            Set m_clsLabelHelp(idx) = New CLabelHelp  'CLabelHelpをNew

            Call m_clsLabelHelp(idx).Init(ctr, txtHelp, Me.Name)    'CLabelHelpクラスのInitメソッドを実行

            idx = idx + 1

        End If

    Next

    txtHelp.Left = 15

    txtHelp.Top = 15

    txtHelp.Width = 6000

    txtHelp.Height = 470

    txtHelp.Visible = False

    Exit Sub

Err_Exit:

End Sub

'----------------------------------------------------------------

'クラスモジュール「CLabelHelp」は下記の通りです。

'----------------------------------------------------------------

Option Compare Database

Option Explicit

'' ラベルヘルプクラス

''

'' 公開プロパティ

''      なし

''

'' 公開メソッド

''      Init            初期処理

''

''  概要

''      ラベルをクリックすることによりヘルプを表示できるようにする。

''

Dim WithEvents m_lbl    As Label        '' クリックされるラベル

Dim m_txtHelp           As TextBox      '' ヘルプ表示

Dim m_sMsg              As String       '' ヘルプ内容

Dim m_sFormName         As String       '' フォーム名

Dim m_lBackStyle        As Long         '' 背景スタイル

Dim m_lBackColor        As Long         '' 背景色

'' クラス初期化

''

'' 引数 I/O

''    I/  クリックされるラベル

''    I/  ヘルプ表示ラベル

''    I/  フォーム名

''

'' 戻値

''      なし

''

'' 概要

''      クラスの初期化を行う。

''

Public Sub Init(lbl As Label, txtHelp As TextBox, sFormName As String)

    Dim colRecs As New Collection

    Dim sSQL    As String

    '' フォーム名

    m_sFormName = sFormName

On Error GoTo Err_Proc

    '' 記憶

    Set m_lbl = lbl

    Set m_txtHelp = txtHelp

    m_lBackStyle = lbl.BackStyle

    m_lBackColor = lbl.BackColor

    '' イベントの設定

    m_lbl.OnMouseDown = "[イベント プロシージャ]"

    m_lbl.OnMouseUp = "[イベント プロシージャ]"

    m_lbl.OnDblClick = "[イベント プロシージャ]"

    If m_sFormName = "frmMain" And m_lbl.Name = "lbl_01" Then

        m_sMsg = "★ああああああああああああ★"

    ElseIf m_sFormName = "frmMain" And m_lbl.Name = "lbl_02" Then

        m_sMsg = "テストテストテストテストテストテスト"

    End If

    '' ヘルプがあればアンダーライン

    If m_sMsg <> "" Then

        m_lbl.FontUnderline = True

    End If

Err_Proc:

End Sub

'' ラベルマウスダブルクリックイベント

''

'' 概要 ヘルプを表示。

''

Private Sub m_lbl_DblClick(Cancel As Integer)

    Call m_lbl_MouseDown(0, 0, 0, 0)

End Sub

'' ラベルマウスダウンイベント

''

'' 概要 ヘルプを表示。

''

Private Sub m_lbl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    '' ヘルプがなければ終了

    If m_sMsg = "" Then

        Exit Sub

    End If

    '' ラベル背景色変更

    m_lbl.BackStyle = 1

    m_lbl.BackColor = &HC0FFFF

    '' ヘルプ表示

    m_txtHelp.Value = m_sMsg

    m_txtHelp.Visible = True

End Sub

'' ラベルマウスアップイベント

''

'' 概要 ヘルプを非表示。

''

Private Sub m_lbl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    '' ラベル背景色を戻す

    m_lbl.BackStyle = m_lBackStyle

    m_lbl.BackColor = m_lBackColor

    '' ヘルプ非表示

    m_txtHelp.Visible = False

End Sub

Microsoft 365 と Office | アクセス | 家庭向け | Windows

ロックされた質問。 この質問は、Microsoft サポート コミュニティから移行されました。 役に立つかどうかに投票することはできますが、コメントの追加、質問への返信やフォローはできません。

0 件のコメント コメントはありません

2 件の回答

並べ替え方法: 最も役に立つ
  1. Anonymous
    2017-02-15T04:06:48+00:00

    新規のファイルで作ってみたんですけど、再現してます(Win7 Pro SP1 + Office Pro Plus 2013)。。。

    修正プログラムは、会社内のWSUSしか接続してない(Microsoft Updateにつなぐと、パッチの適用状態がおかしくなるかも、と思って怖くて接続してません。あと、インターネット接続はプロキシ経由(認証有り)なので、許可されて無いかも、です)ので、配布のポリシーというか、WSUS管理者が何か間違っているのかも知れません。

    試していただいて、ありがとうございました。

    この回答は役に立ちましたか?

    0 件のコメント コメントはありません
  2. Anonymous
    2017-02-15T03:09:03+00:00

    こんにちは。

    環境は違うのですが(Win8.1+Acc2016)、試してみましたが問題なく動作しました。

    切り分けのため、新規のファイルで作っても問題が起きるか試してみてください。

    あとは何かが修正プログラムで直されている可能性もあるかもしれないので、

    Acc2013が最新の状態か(最新の更新プログラムが適用されているか)の確認もしてみてください。

    この回答は役に立ちましたか?

    0 件のコメント コメントはありません