Показать сообщение отдельно
Старый 10.11.2005, 15:14     # 5
LightImage
Junior Member
 
Регистрация: 16.10.2002
Адрес: Россия-матушка
Пол: Male
Сообщения: 96

LightImage Нимб уже пробиваетсяLightImage Нимб уже пробивается
Цитата:
Raven B.:
1. В аксесе есть возможность настраивать параметры запуска. Случайно выделил не то что надо (стандартные опции меню запртил). В результате хочу их вернуть, но... неоткуда.
При открытии базы держи Shift. Поможет, если эта возможность в .mdb файле не запрещена. Если запрещена, то надо использовать VBA, код скину позже.
P.S. В твоем коде All_Not_Loaded() всегда будет True возвращать, она же вызывается из еще открытой формы
P.P.S. А вот обещаный код:
Код:
Public Function LI_SetPropertyToObject(obj As Object, pname As String, pvalue, ptype, _
    Optional doCheckPropVal As Boolean = True) As Boolean
' Создает или модифицирует свойство с именем pname объекта obj.
' Тип свойства указывается параметром ptype, значение свойства -- параметром pvalue.
' Если параметр doCheckPropVal = True, то функция будет изменять значение указанного
' свойства только если оно отличается от pvalue.
' См. справку по функции CreateProperty() для допустимых значений параметра ptype.
' Возвращаемое значение:
'  False, если свойство уже существовало и его значение не было изменено,
'  True, если свойство не существовало и было создано этой функцией,
'   или значение свойства было изменено.
' При возникновении ошибок возникшие ошибки будут выкинуты вызвающей функции
Dim prpNew As Property
Dim errLoop As Error
Dim retv As Boolean
    retv = False
    
    On Error GoTo Err_Property
    If doCheckPropVal Then
        If obj.Properties(pname) = pvalue Then
            GoTo func_exit
        End If
    End If

DoAssignVal:
    obj.Properties(pname) = pvalue
    retv = True
    On Error GoTo 0

func_exit:
    LI_SetPropertyToObject = retv
    Exit Function

Err_Property:

' Ошибка 3270 означает, что свойство не найдено.
Const conPropNotFoundError = 3270
    If Err = conPropNotFoundError Then
        ' Создает свойство, задает его значение и добавляет
        ' свойство в семейство Properties.
        Set prpNew = obj.CreateProperty(pname, ptype, pvalue)
        obj.Properties.Append prpNew
        Resume DoAssignVal
    Else
        ' При возникновении другой ошибки выкидываем её вызывающей функции
        Err.Raise Err.Number
    End If
End Function

Sub My_DoChangeAllowBypassKey()
Const prpname = "AllowBypassKey", prpvalue As Boolean = True
Const dbpath = "C:\temp\test.mdb"
Dim dbs As database
    Set dbs = OpenDatabase(dbpath)
    LI_SetPropertyToObject dbs, prpname, prpvalue, dbBoolean
End Sub
__________________
1 миллибайт = 1/1024 байта

Последний раз редактировалось LightImage; 10.11.2005 в 17:22. Причина: добавление полезной инфы
LightImage вне форума