Public Function funInsertBtnClose(frm As Form) As Boolean
On Error GoTo Err_function
Dim lngReturn As Long
Dim ctrl As CommandButton
Dim strText As String
Dim ctl As Control
funInsertBtnClose = False
'Закрыть
For Each ctl In frm.Controls
If ctl.Name = "btnClose" Then
MsgBox "btnClose в форме '" & frm.Name & "' уже имеется", , "Мастер кнопки 'закрыть'"
Exit Function
End If
Next ctl
Set ctrl = CreateControl(frm.Name, acCommandButton, acDetail)
With ctrl
.Name = "btnClose"
.Caption = "Закрыть"
.Height = 340
.Width = 1020
.Left = frm.Width - 1120
.Top = 100
.FontName = "Tahoma"
.FontSize = 8
.ForeColor = 16711680
' .Cancel = True
.ControlTipText = "Закрыть форму"
End With
With frm.Module
lngReturn = .CreateEventProc("Click", ctrl.Name)
.InsertLines lngReturn + 1, "On Error GoTo Err_btnClose_Click"
.InsertLines lngReturn + 2, vbTab & "DoCmd.Close acForm, Me.Name"
.InsertLines lngReturn + 3, "Exit_btnClose_Click:"
.InsertLines lngReturn + 4, vbTab & "Exit Sub"
.InsertLines lngReturn + 5, "Err_btnClose_Click:"
.InsertLines lngReturn + 6, vbTab & "MsgBox Err.Description, vbExclamation, Me.Caption"
.InsertLines lngReturn + 7, vbTab & "Resume Exit_btnClose_Click"
End With
funInsertBtnClose = True
Exit_function:
Exit Function
Err_function:
MsgBox Err.Description
Resume Exit_function
End Function
|