Sub PermanentFormFonts (strFont As String)
On Error GoTo PermanentFormFonts_Err
Dim objAO As AccessObject
Dim objCP As Object
Dim ctlControl As Control
Set objCP = Application.CurrentProject
For Each objAO In objCP.AllForms
DoCmd.OpenForm objAO.Name, acDesign, , , , acHidden
For Each ctlControl In objAO.Controls
ctlControl.FontName = strFont
Next
DoCmd.Close acForm, objAO.Name, acSaveYes
Next
PermanentFormFonts_Exit:
Exit Sub
PermanentFormFonts_Err:
If Err.Number = 438 Then
Resume Next
Else
MsgBox Err.Description
Resume PermanentFormFonts_Exit
End If
End Sub