|
|
Список всех полей БД со Свойством Подстановки + Их удаление (опционально)
Public Sub PrintAll_LookupFields_in_Tables(Optional bolFixProperty As Boolean = False)
Dim tdf As DAO.TableDef
Dim objField As DAO.Field
Dim bolHasPrp As Boolean
Dim objPrp As Property
Dim s$, sTName$, sFLDName$, sPrpName$, iTbls%, iErr%
Const iLineLength% = 72
Debug.Print String(iLineLength, "-")
For Each tdf In CurrentDb.TableDefs
If (tdf.Attributes And dbSystemObject) = False Then
sTName = tdf.Name
iTbls = iTbls + 1
For Each objField In tdf.Fields
sFLDName = objField.Name
bolHasPrp = CheckPropertyPresent(objField, "DisplayControl")
If bolHasPrp = True Then
Set objPrp = objField.Properties("DisplayControl")
If objPrp.Value = 111 Or objPrp.Value = 110 Then
iErr = iErr + 1
If bolFixProperty = True Then
objPrp.Value = 109
s = vbTab & "Табл: [" & sTName & "]" & _
" - Поле: [" & sFLDName & "] " & _
"Свойство: [DisplayControl] " & _
" - исправлено на 109(TextBox)."
Else
s = "Табл: [" & sTName & "]" & _
" - Поле с подстановкой : " & sFLDName
End If
Debug.Print s
End If
End If
Next objField
End If
Next tdf
If iErr > 0 Then
Debug.Print String(iLineLength, "-")
If bolFixProperty = False Then
s = "Обработано: " & iTbls & " таблиц" & _
" - Найдено полей с подстановкой : " & iErr
Else
s = "Обработано: " & iTbls & " таблиц" & _
" - Исправлено (удалено) полей с подстановкой : " & iErr
End If
Else
s = "Обработано: " & iTbls & " таблиц и полей с подстановкой не найдено!"
End If
Debug.Print s
Debug.Print String(iLineLength, "=")
End Sub
Private Function CheckPropertyPresent(obj As Object, sPrpName$) As Boolean
Dim vVal
On Error GoTo CheckPropertyPresent_Err
vVal = obj.Properties(sPrpName)
CheckPropertyPresent = True
CheckPropertyPresent_End:
Exit Function
CheckPropertyPresent_Err:
Err.Clear
Resume CheckPropertyPresent_End
End Function
Дополнительно:
If objField.Type = 1 Then
If Not objField.Properties("DisplayControl") = 106 Then
Debug.Print sTName
Debug.Print objField.Name & " - " & objField.Type
Debug.Print objField.Properties("DisplayControl")
objField.Properties("DisplayControl") = 106
End If
End If
|
|