| |
|
|
| | Мало ли пригодится. Некоторые формы могут отображаться кривыми шрифтами на новых машинках, если не указан шрифт табличной формы
За основу кода взята статья Юрия Шермана.
http://hiprog.com/index.php?option=com_content&task=view&id=442
А выглядит бонус так:
Sub ChangeShrift()
' изменяет шрифты для всех табличных форм в базе
Dim frm As Form, ctl As Control
Dim FormName As String, n As Long
'On Error Resume Next
'Перебираем все формы
For n = 0 To CurrentDb.Containers("Forms").Documents.Count - 1
FormName = CurrentDb.Containers("Forms").Documents(n).Name
SysCmd acSysCmdSetStatus, FormName
'Открываем форму в режиме конструктора
If FormName <> "СкрытаяФорма" Then
DoCmd.OpenForm FormName, acDesign, , , , acHidden
Set frm = Forms(FormName)
'---- этими строчками можно дополнить код в статье ЮШ
If frm.AllowDatasheetView=True Then
frm.DatasheetFontName = "Arial"
frm.DatasheetFontHeight = 9
'----------------------
DoCmd.Close acForm, FormName, acSaveYes
Else
DoCmd.Close acForm, FormName, acSaveNo
End If
End If
Next n 'следующая форма
SysCmd acSysCmdClearStatus
MsgBox "Обработано форм: " & n, vbInformation
End Sub
|
Удачи :) | |
| |
| |
| |
|
|
| | До кучи.
Иногда бывает полезно и в отчетах :
Вот код:
Public Sub AllReportsCyrillec()
Dim obj As AccessObject, dbs As Object
Dim k%
Dim ctl As Control
k = 0
'шрифт который меняем
Const arialcyr = "Arial Cyr"
Const newarialcyr = "Arial"
Set dbs = Application.CurrentProject
' Search for open AccessObject objects in AllReports collection.
For Each obj In dbs.AllReports
k = k + 1
' Print name of obj.
'debug.print k, obj.name
debug.print obj.name
If InStr(1, obj.name, "Etiketka") > 0 Then GoTo 111 'обработка исключений (этот отчет не трогать!)
DoCmd.OpenReport obj.name, acViewDesign, , , acHidden
With Reports(obj.name)
For Each ctl In Reports(obj.name).Controls
If ctl.Properties(2) = 100 Or ctl.Properties(2) = 109 Then
'debug.print "" & ctl.name
'debug.print "" & ctl.Properties(2)
On Error Resume Next
'debug.print ""; ctl.Properties("FontName")
If arialcyr = ctl.Properties("FontName") Then
ctl.Properties("FontName") = newarialcyr 'шрифт НА который меняем
'debug.print "заменили"
End If
End If
Next
End With
DoCmd.Close acReport, obj.name, acSaveYes
111:
Next obj
MsgBox Now(), , "Всего отчетов в базе " & k
End Sub
|
| |
| |
| |
