> Root Key. Строка, представляющая ветвь реестра, к которой обращается функция.
Эта строка может принимать одно из следующих значений:
• HKEY_CLASSES_ROOT;
• HKEY_CURRENT_USER;
• HKEY_LOCAL_MACHINE;
• HKEY_USERS;
• HKEY_CURRENT_CONFIG.
> Path. Полный путь в реестре. Если пути не существует, он будет создан.
> RegEntry. Название раздела реестра, в который записывается значение. Если раз-
дела не существует, он будет добавлен в реестр.
> RegVal. Значение, которое записывается в реестр.
Sub Workbook_Open()
RootKey = "hkey_current_user"
Path = "software\microsoft\of fice\15.0\excel\LastStarted,?
RegEntry = "DateTime"
RegVal = Now()
If WriteRegistry(RootKey, Path, RegEntry, RegVal) Then
msg = RegVal & " сохранено в реестре."
Else msg = "произошла ошибка"
End If
MsgBox msg
End Sub
Если вы решили воспользоваться системным реестром для хранения и проверки на-
строек приложений Excel, не стоит обращаться к функциям Windows API. Лучше вос-
пользоваться функциями VBA GetSetting и SaveSetting. Эти функции намного про-
ще в применении, чем функции Windows API.
Эти две функции описаны в соответствующем разделе справочной системы, поэтому
здесь они подробно не рассматриваются. Важно понимать, что они работают только со
следующим разделом реестра:
HKEY_CURRENT_USER\SoftwareWB and VBA Program Settings Другими словами, с помощью этих функций можно управлять данными только одной вет-
ви реестра, в которой сохраняются базовые настройки Excel. Данные функции лучше ис-
пользовать для хранения сведений о приложении Excel между сеансами его выполнения.
Private Declare PtrSafe Function RegOpenKeyA Lib "ADVAPI32.DLL" _
(ByVal hKey As Long, ByVal sSubKey As String, _
ByRef hkeyResult As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "ADVAPI32.DLL" _
(ByVal hKey As Long) As Long
Private Declare PtrSafe Function RegSetValueExA _
Lib "ADVAPI32.DLL" (ByVal hKey As Long, ByVal
sValueName As String, _
ByVal dwReserved As Long, ByVal dwType As Long, _
ByVal sValue As String, ByVal dwSize As Long) As Long
Private Declare PtrSafe Function RegCreateKeyA Lib _
"ADVAPI32.DLL" (ByVal hKey As Long, ByVal sSubKey As String,
ByRef hkeyResult As Long) As Long
Private Declare PtrSafe Function RegQueryValueExA Lib _
"ADVAPI32.DLL" (ByVal hKey As Long, ByVal
sValueName As String, ByVal dwReserved As Long, _
ByRef lValueType As Long, _
ByVal sValue As String, ByRef IResultLen As Long) As Long
Одна из самых важных возможностей VBA — поддержка функций, которые хранятся
в динамически подключаемых библиотеках (Dynamic Link Libraries — DDL).
Определение файловых ассоциаций
Функция GetExecutable вызывает функцию Windows API, чтобы получить полный
путь к приложению, связанному с указанным файлом.
Объявления функций Windows API должны находиться в верхней части модуля VBA.
Private Declare PtrSafe Function FindExecutableA Lib _
Hshell32.dll" (ByVal lpFile As String, ByVal _
lpDirectory As String, ByVal IpResult As String) As Long
Function GetExecutable(strFile As String) As String
Dim strPath As String
Dim intLen As Integer
strPath = Space(255)
intLen = FindExecutableA (strFile, "\,f, strPath)
GetExecutable = Trim(strPath)
End Function
Function SORTED(Rng)
Dim SortedDataO As Variant
Dim Cell As Range
Dim Temp As Variant, i As Long, j As Long
Dim NonEmpty As Long
' Передача данных в массив SortedData
For Each Cell In Rng
If Not IsEmpty(Cell) Then
NonEmpty = NonEmpty + 1
ReDim Preserve SortedData(1 To NonEmpty)
SortedData(NonEmpty) = Cell.Value
End If
Next Cell
1 Сортировка массива
For i = 1 To NonEmpty
For j = i + 1 To NonEmpty
If SortedData(i) > SortedData(j) Then
Temp = SortedData(j)
SortedData(j) = SortedData(i)
SortedData(i) = Temp
End If
Next ]
Next l
' Транспонирование массива и его возврат
SORTED = Application.Transpose(SortedData)
End Function
Функция SORTED начинает свою работу с создания массива SortedData. Этот массив
содержит все непустые значения из массива аргументов. Затем выполняется сортировка
массива пузырьковым методом. И поскольку массив является горизонтальным, его нужно
транспонировать перед возвратом функцией.
Возвращение максимального значения среди всех рабочих листов
Функция MAXALLSHEETS, показанная ниже, принимает аргумент (одна ячейка) и воз-
вращает максимальное значение в этой ячейке во всех рабочих листах данной книги.
Function MAXALLSHEETS(cell)
Dim MaxVal As Double
Dim Addr As String
Dim Wksht As Object
Application.Volatile
Addr = cell.Range("A1M).Address
MaxVal = -9.9E+307
For Each Wksht In cell.Parent.Parent.Worksheets
If Wksht.Name = cell.Parent.Name And _
Addr = Application.Caller.Address Then
' исключение циклической ссылки
Else
If IsNumenc (Wksht.Range (Addr) ) Then
If Wksht.Range(Addr) > MaxVal Then _
MaxVal = Wksht.Range(Addr).Value
End If
End If
Next Wksht
If MaxVal = -9.9E+307 Then MaxVal = 0
MAXALLSHEETS = MaxVal
End Function
В цикле For Each для доступа к рабочей книге используется следующее выражение:
cell.Parent.Parent.Worksheets
“Родителем” ячейки является рабочий лист, “родителем” рабочего листа — рабочая
книга. Следовательно, цикл For Each обходит все рабочие листы в книге. Первый опе-
ратор I f в цикле проверяет, содержит ли ячейка, которая проверяется в данный момент,
функцию. Если содержит, то ячейка игнорируется во избежание циклической ссылки.
Function SHEETOFFSET(Offset As Long, Optional Cell As Variant)
' Возвращение содержимого ячейки по ссылке на нее
Dim Wkslndex As Long, WksNum As Long
Dim wks As Worksheet
Application.Volatile
If IsMissing(Cell) Then Set Cell = Application.Caller
WksNum = 1
For Each wks In Application.Caller.Parent.Parent.Worksheets
If Application.Caller.Parent.Name = wks.Name Then
SHEETOFFSET = Worksheets(WksNum +
Offset).Range(Cell(1).Address)
Exit Function
Else
WksNum = WksNum + 1
End If
Next wks
End Function
Function STATFUNCTION(rng, op)
Select Case UCase(op)
Case "СУММ"
STATFUNCTION =
Case "СРЗНАЧ"
STATFUNCTION =
Case "МЕДИАНА"
STATFUNCTION =
Case "МОД"
STATFUNCTION =
Case "СЧЕТ"
STATFUNCTION =
Case "MAKC"
STATFUNCTION =
Case "МИН"
STATFUNCTION =
Case "ДИСП"
STATFUNCTION =
Case "СТАНДОТКЛОН
STATFUNCTION =
WorksheetFunction.Sum(rng)
WorksheetFunction.Average(rng)
WorksheetFunction.Median(rng)
WorksheetFunction.Mode(rng)
WorksheetFunction.Count(rng)
WorksheetFunction.Max(rng)
Worksheet Function. M m (rng)
WorksheetFunction.Var(rng)
I
WorksheetFunction.StDev(rng)
Case Else
STATFUNCTION = CVErr(xlErrNA)
End Select
End Function
