William Benson (VBACreations.Com)
vbacreations at gmail.com
Mon Aug 29 08:33:05 CDT 2011
Sorry - to make more sense, I use screen.activeform.name,
screen.activeform.ActiveControl.Name and
screen.activeform.ActiveControl.Caption in the same function called a
button's click event. The function has grown a lot and is hard to read now
but I always know where to look for the button clicks according to their
captions. I guess if I wanted others besides me to figure this out I would
document a little prettier.
'Some example code:
Set frm = Screen.ActiveForm
Set Ctl = frm.ActiveControl
Set D = CurrentDb
Select Case Ctl.caption
Case Is = "Refresh Me"
RefreshMe frm
Case Is = "Compact"
CompactMe
Case Is = "Match Report Parent"
sCtrl = Screen.ActiveForm.Controls("SF1").Form.ActiveControl.Name
If sCtrl = "IIR_Owner" Then
strBasis = "Owner_Name"
ElseIf sCtrl = "IIR_Parent" Then
strBasis = "ParentName"
ElseIf sCtrl = "Gib_Domestic_Customer_Name" Then
strBasis = "Domestic_Customer_Name"
ElseIf sCtrl = "Gib_Regional_Customer_Name" Then
strBasis = "Regional_Customer_Name"
ElseIf sCtrl = "GIB_Global_Customer_Name" Then
strBasis = "Global_Customer_Name"
Else
MsgBox "You were not in a parent-type control - canceled.",
vbInformation
Exit Function
End If
strSingleParent =
Screen.ActiveForm.Controls("SF1").Form.ActiveControl.Value
D.Execute "delete from TblReportHeaders where reportid = -1",
dbFailOnError
D.Execute "delete from TblReportSelections where fkreportid = -1",
dbFailOnError
D.Execute "delete from TblReportHeaders where ReportName =
'Single-Parent: " &
JetSQLFixup(Screen.ActiveForm.Controls("SF1").Form.Controls(sCtrl)) & "'",
dbFailOnError
SQL = ""
SQL = SQL & " Insert into tblReportHeaders "
SQL = SQL & " (ReportID, Source, Level1Basis, ReportName, CreatorSSO)"
SQL = SQL & " Values (-1,'" & UCase(Left(sCtrl, 3)) & "',"
SQL = SQL & "'" & strBasis & "',"
SQL = SQL & "'Single-Parent: " &
JetSQLFixup(Screen.ActiveForm.Controls("SF1").Form.Controls(sCtrl)) & "',"
SQL = SQL & "'" & ap_GetUsername & "')"
D.Execute SQL, dbFailOnError
SQL = "Insert Into tblreportselections (fkreportid,SelectedItem) Values
(-1,'" & JetSQLFixup(strSingleParent) & "')"
D.Execute SQL, dbFailOnError
SQL = "Update Tbl_Match_Fields Set [Level1ID_GIB] = 'Global_DB',
[Level1ID_IIR] = 'Parent_ID', [Level2ID_GIB] = 'Regional_DB', [Level2ID_IIR]
= 'Owner_ID1', [Level3ID_GIB] = 'Domestic_DB', [Level3ID_IIR] = 'Owner_ID2',
[Level1Name_GIB] = 'Regional_Customer_Name', [Level1Name_IIR] =
'ParentName', [Level2Name_GIB] = 'Global_Customer_Name', [Level2Name_IIR] =
'Owner_Name', [Level3Name_GIB] = 'Domestic_Customer_Name', [Level3Name_IIR]
= 'Own_Name2'"
D.Execute SQL, dbFailOnError
SQL = "Update Tbl_Match_Fields Set Level1Name_" & Left(sCtrl, 3) & " = '"
& strBasis & "'"
D.Execute SQL, dbFailOnError
DoCmd.OpenForm "frmmatchreport", acNormal, , , acFormEdit, acWindowNormal
DoEvents
If Forms("frmMatchReport").Controls("cbobasis") <> Left(UCase(sCtrl), 3)
Then
Forms("frmMatchReport").Controls("cbobasis") = Left(UCase(sCtrl), 3)
Call Forms("frmMatchReport").cboBasisChange
DoEvents
End If
' Forms("frmMatchReport").Controls("cbobasislevel1") = strBasis
' DoEvents
Forms("frmMatchReport").Controls("cboreportheader").Requery
DoEvents
For i = 1 To Forms("frmMatchReport").Controls("cboreportheader").ListCount
If Forms("frmMatchReport").Controls("cboreportheader").Column(0, i) = -1
Then
Forms("frmMatchReport").Controls("cboreportheader").Selected(i) = True
Call Forms("frmMatchReport").cboReportHeaderAfterUpdate
Exit For
End If
Next
Set rClone =
Forms("frmMatchReport").Controls("Subfrm_Matching_Count_By_Entity").Form.Rec
ordsetClone
rClone.MoveFirst
rClone.FindFirst "[Entity] = '" & strSingleParent & "'"
If Not rClone.NoMatch Then
Forms("frmMatchReport").Controls("Subfrm_Matching_Count_By_Entity").Form.Boo
kmark = rClone.Bookmark
End If
DoEvents
Case Is = "Test Workbook"
If Screen.ActiveForm.Name = "frm_imex_specs" Then
TestExcelThisData Screen.ActiveForm.Controls("SF1").Form!specname
End If
Case Is = "Hide Parent ID"
MAtchedView = 0
Screen.ActiveForm.ActiveControl.caption = "Show Parent ID"
StorPlantID = Screen.ActiveForm.Controls("SF1").Form!IIR_Plant_ID
If Screen.ActiveForm.Controls("SF1").Form.FilterOn Then
sMatchedFilter = StorPlantID = Screen.ActiveForm.Controls("SF1").Filter
bMatchedFilterOn = True
Else
bMatchedFilterOn = False
End If
Screen.ActiveForm.Controls("SF1").SourceObject = ToggleMatchedView
Set rst = Nothing
Set rst = Screen.ActiveForm.Controls("SF1").Form.RecordsetClone
rst.FindFirst "IIR_Plant_ID = " & StorPlantID
If Not rst.NoMatch Then
Screen.ActiveForm.Controls("SF1").Form.Bookmark = rst.Bookmark
End If
If bMatchedFilterOn Then
Screen.ActiveForm.Controls("SF1").Form.Filter = sMatchedFilter
StorPlantID = Screen.ActiveForm.Controls("SF1").Form.FilterOn = True
End If
Case Is = "Matched Sites Tbl"
RefreshMatchedSiteDetails
DoCmd.OpenTable "Tbl_Matched_Sites"
Case Is = "GIB Table"
ViewTable "GIB", "Site_DB",
Screen.ActiveForm.Controls("sf1").Form.Controls("GIB_Site_DB").Value
Case Is = "IIR Table"
If Screen.ActiveForm.Name = "FrmUnmatched1" Then
ViewTable "IIR", "Plant_ID",
Screen.ActiveForm.Controls("sf2").Form.Controls("IIR_Plant_ID").Value
Else
ViewTable "IIR", "Plant_ID",
Screen.ActiveForm.Controls("sf1").Form.Controls("IIR_Plant_ID").Value
End If
Case Is = "Import Data"
If Not Screen.ActiveForm.Name Like "*IMEX*" Then
DoCmd.OpenForm "frmImportData"
Else
TestExcelThisData Screen.ActiveForm.Controls("SF1").Form!specname
End If
Case Is = "Show Parent ID"
MAtchedView = 1
Screen.ActiveForm.ActiveControl.caption = "Hide Parent ID"
StorPlantID = Screen.ActiveForm.Controls("SF1").Form!IIR_Plant_ID
If Screen.ActiveForm.Controls("SF1").Form.FilterOn Then
sMatchedFilter = StorPlantID = Screen.ActiveForm.Controls("SF1").Filter
bMatchedFilterOn = True
Else
bMatchedFilterOn = False
End If
Screen.ActiveForm.Controls("SF1").SourceObject = ToggleMatchedView
Set rst = Nothing
Set rst = Screen.ActiveForm.Controls("SF1").Form.RecordsetClone
rst.FindFirst "IIR_Plant_ID = " & StorPlantID
If Not rst.NoMatch Then
Screen.ActiveForm.Controls("SF1").Form.Bookmark = rst.Bookmark
End If
If bMatchedFilterOn Then
Screen.ActiveForm.Controls("SF1").Form.Filter = sMatchedFilter
StorPlantID = Screen.ActiveForm.Controls("SF1").Form.FilterOn = True
End If
Case Is = "Deletion History"
DoCmd.OpenForm "frmDeletedItems", acFormDS, , , acFormReadOnly,
acWindowNormal
Case Is = "Show Matched"
DoCmd.OpenForm "frmMatched1", acNormal, , , acFormEdit, acWindowNormal
Case Is = "Show Unmatched"
DoCmd.OpenForm "frmUnmatched1", acNormal, , , acFormEdit, acWindowNormal
Case Is = "Show Stats This IIR Parent"
GetStatsForParentIIR
Case Is = "Rebuild Database"
ReplicateDatabase
Case Is = "Show Stats This GIB Parent"
GetStatsForParentGIB
Case Is = "Match Report"
DoCmd.OpenForm "frmmatchreport", acNormal, , , acFormEdit, acWindowNormal
'BasicMatchReport
Case Is = "Import Matched Sites"
ImportMatches
Case Is = "Export Matched Sites"
ExportTblMatchedSites
Case Is = "Remove Match"
Call RemoveThisMatch
Case Is = "Make &Match"
Call MakeTheseMatch
Case Is = "Remove Filter for IIR Form"
l_iPending_IIR_Plant_ID_For_Match = g_iPending_IIR_Plant_ID_For_Match
Set sf = frm.Controls(Right(Ctl.Tag, 3))
sf.Form.FilterOn = False
sf.Form.Filter = ""
Set rst = sf.Form.RecordsetClone
rst.FindFirst ("[IIR_Plant_ID] = " & l_iPending_IIR_Plant_ID_For_Match)
If Not rst.NoMatch Then
sf.Form.Bookmark = rst.Bookmark
End If
Case Is = "Remove Filter for GIB Form"
l_sPending_GIB_Site_DB_For_Match = g_sPending_GIB_Site_DB_For_Match
Set sf = frm.Controls(Right(Ctl.Tag, 3))
sf.Form.FilterOn = False
sf.Form.Filter = ""
Set rst = sf.Form.RecordsetClone
rst.FindFirst ("[GIB_Site_DB] = '" & l_sPending_GIB_Site_DB_For_Match &
"'")
If Not rst.NoMatch Then
sf.Form.Bookmark = rst.Bookmark
End If
Case Is = "Remove Filter"
Set sf = frm.Controls("SF1")
sf.Form.FilterOn = False
sf.Form.Filter = ""
Set rst = sf.Form.RecordsetClone
rst.FindFirst ("[IIR_Plant_ID] = " & l_iPending_IIR_Plant_ID_For_Match)
If Not rst.NoMatch Then
sf.Form.Bookmark = rst.Bookmark
End If
Case Else
MsgBox "No code yet set for button with caption '" & Ctl.caption
End Select
End Function