↓メインのフォームのコードは下記の通りです。
コントロールは、テキストボックス「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