Алексей Гладкий - Excel. Трюки и эффекты

strTitle As String ' Заголовок окна

ulFlags As Long ' Флаги для окна

' Следующие три параметра в VBA не используются

lpfn As Long

lParam As Long

iImage As Long

End Type

Sub BrowseFolder1()

Dim strPath As String ' Папка, список файлов которой выводится

Dim strFile As String

Dim intRow As Long ' Текущая строка таблицы

' Выбор папки

strPath = dhBrowseForFolder()

If strPath = "" Then Exit Sub

If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

' Оформление заголовка отчета

ActiveSheet.Cells.ClearContents

ActiveSheet.Cells(1, 1) = «Имя файла»

ActiveSheet.Cells(1, 2) = «Размер»

ActiveSheet.Cells(1, 3) = «Дата/время»

ActiveSheet.Range(«A1:C1»).Font.Bold = True

' Просмотр объектов в папке...

' Первый объект папки

strFile = Dir(strPath, 7)

intRow = 2

Do While strFile <> ""

' Запись в столбец "A" имени файла

ActiveSheet.Cells(intRow, 1) = strPath & strFile

' Запись в столбец "B" размера файла

ActiveSheet.Cells(intRow, 2) = FileLen(strPath & strFile)

' Запись в столбец "C" времени изменения файла

ActiveSheet.Cells(intRow, 3) = FileDateTime(strPath &

strFile)

' Следующий объект папки

strFile = Dir

intRow = intRow + 1

Loop

End Sub

Function dhBrowseForFolder() As String

Dim biBrowse As BROWSEINFO

Dim strPath As String

Dim lngResult As Long

Dim intLen As Integer

' Заполнение полей структуры BROWSEINFO

' Корневая папка – Рабочий стол

biBrowse.pidlRoot = 0&

' Заголовок окна

biBrowse.strTitle = «Выбор папки»

' Тип возвращаемой папки

biBrowse.ulFlags = &H1

' Выводим стандартное окно просмотра папок

lngResult = SHBrowseForFolder(biBrowse)

' Обработка результата работы окна

If lngResult Then

' Получение пути (по возвращенным данным)

strPath = Space$(512)

If SHGetPathFromIDList(ByVal lngResult, ByVal strPath)

Then

' Строка пути заканчивается символом Chr(0)

intLen = InStr(strPath, Chr$(0))

' Выделение и возврат пути

dhBrowseForFolder = Left(strPath, intLen – 1)

Else

' Не удалось получить путь

dhBrowseForFolder = ""

End If

Else

' Пользователь нажал кнопку «Отмена» в окне

dhBrowseForFolder = ""

End If

End Function

После написания данного кода в окне выбора макросов станет доступным макрос BrowseFolderl. Результат его выполнения показан на рис. 3.38.

Рис. 3.38. Список файлов суказанием пути

На рисунке видно, что для каждой позиции данного списка указывается полный путь к файлу.

При необходимости можно быстро получить и вывести на активном рабочем листе разнообразную информацию о текущем состоянии дисков компьютера. Для этого достаточно воспользоваться макросом, код которого выглядит так (листинг 3.99).

Sub DrivesInfo()

Dim objFileSysObject As Object ' Объект для работы _

с файловой системой

Dim objDrive As Object ' Анализируемый диск

Dim intRow As Integer ' Заполняемая строка листа

' Создание объекта для работы с файловой системой

Set objFileSysObject = CreateObject(«Scripting.FileSystemObject»)

' Очистка листа

Cells.Clear

' Запись с первой строки

intRow = 1

' Запись на лист информации о дисках компьютера

On Error Resume Next

For Each objDrive In objFileSysObject.Drives

' Буква диска

Cells(intRow, 1) = objDrive.DriveLetter

' Готовность

Cells(intRow, 2) = objDrive.IsReady

' Тип диска

Select Case objDrive.DriveType

Case 0

Cells(intRow, 3) = «Неизвестно»

Case 1

Cells(intRow, 3) = «Съемный»

Case 2

Cells(intRow, 3) = «Жесткий»

Case 3

Cells(intRow, 3) = «Сетевой»

Case 4

Cells(intRow, 3) = «CD-ROM»

Case 5

Cells(intRow, 3) = «RAM»

End Select

' Метка диска

Cells(intRow, 4) = objDrive.VolumeName

' Общий размер

Cells(intRow, 5) = objDrive.TotalSize

' Свободное место

Cells(intRow, 6) = objDrive.AvailableSpace

intRow = intRow + 1

Next

End Sub

После написания кода в окне выбора макросов появится макрос Driveslnf о. В результате его выполнения на текущем рабочем листе будет сформирован список, пример которого показан на рис. 3.39.

Рис. 3.39. Список с информацией о дисках компьютера

Для каждой позиции списка последовательно указывается буква диска, его «готовность к работе» в данный момент, тип диска, общий объем диска и свободное в настоящее время место на нем.

Очевидно, что содержимое данного списка зависит от конфигурации используемого компьютера.

В данном разделе мы рассмотрим небольшой трюк, с помощью которого можно быстро рассчитать среднее значение ячеек, расположенных над активной ячейкой, с отображением результата в активной ячейке.

Как известно, расчет среднего значения можно выполнять штатными средствами Excel – с помощью функции СРЗНАЧ. Однако в некоторых случаях удобнее воспользоваться макросом, код которого представлен в листинге 3.100 (этот код нужно набрать в стандартном модуле редактора VBA).