Листинг2. Открытие книги при помощи встроенного окна
Sub DemoDialogs() Dim idx As Long
idx = Application.Dialogs (xlDialogOpen) .Show("с: \test.xls") If idx Then
MsgBox "Файл открыт" Else
MsgBox "Файл не открыт" End If
End Sub.
Объект FileDialog
Объект FileDialog, возвращаемый свойством FileDialog объекта Application, предоставляет в распоряжение разработчика диалоговые окна Открыть и Сохранить как. Свойство FileDialog имеет один параметр DiaiogType. задающий тип окна. У этого параметра имеются четыре допустимых значения:
msoFileDialogFiiePicker — позволяет пользователю выбрать файл;
msoFileDialogFolderPicker — позволяет пользователю выбрать папку;
msoFileDialogopen — позволяет пользователю открыть выбранный файл. Открытие файла производится методом Execute;
msoFileDialogsaveAs — позволяет пользователю сохранить файл. Сохранение файла производится методом Execute.
Для отображения окна, симулируемого объектом FileDialog, необходимо воспользоваться методом show. Этот метод возвращает значение 0, если нажата кнопка Отмена и значение -1, если нажата другая функциональная кнопка. Для окон Открыть и Сохранить как после применения надо воспользоваться методом Execute для реализации выбранной команды.
И в следующих трех примерах демонстрируется техника сохранения и загрузки файла при помощи окон, имеющих типы msoFileDialogFilePicker (ЛИСТИНГ3), msoFileDialogOpen (ЛИСТИНГ 4) И msoFileDialogSaveAs (ЛИСТИНГ 5).
Листинг 3. Загрузка файлов с помощью окна msoFiieDiaiogFiiePicker
Sub LoadFiles()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker) Dim itm As Variant With fd
If .Show = -1 Then
For Each itm In .Selectedlterns
Workbooks.Add itm Next End If End With
Set fd = Nothing
End Sub
Листинг 4. Загрузка файла с помощью окна msoFileDialogOpen
Sub LoadFile()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogOpen) If fd.Show = -1 Then
fd.Execute Else
MsgBox "Выбрали отмену" End If
Set fd = Nothing
End Sub.
Листинг 5. Сохранение файла с помощью окна msoFileDialogSaveAs
Sub SaveFile()
Dim fd as FileDialog
Set fd=Application.FileDialog(mso FileDialogSaveAs)
If fd.Show= -1 then
Fd.Execute
End Sub.
Поиск файлов
Свойство FileSearch объекта Application возвращает объект FileSearch, который инкапсулирует и себе свойства и методы,реализующие поиск специфицированного файла на диске. Перечислим основные свойства объекта FileSearch:
- свойство LookIn возвращает или устанавливает каталог, в котором производится поиск.
- свойство FileType возвращает или устанавливает тип искомого файла. Его допустимым значением может быть одна из следующих констант:
msoFileTypeAllFiles
msoFileTypeCalendarItems
msoFileTypeCustom
msoFileTypeDataConnectionFiles
msoFileTypeDocumentImagingFiles
msoFileTypeJournaItem
msoFileTypeNoteItems
msoFileTypeOutLookItems
msoFileTypePowerPoint
msoFileTypeTemplates
msoFileTypeWebPages
msoFileTypeBindere
msoFileTypeContactItems
msoFileTypeDataBases
msoFileTypeMailItems
msoFileTypeOfficeFile
msoFileTypeTarkItems
msoFileTypeVisioItems
msoFileTypeWordDocuments
- свойство FoundFile возвращает объект FoundFiles, представляющий собой список имен всех найденных в течение поиска файлов.
Метод Execute объекта Application производит непосредственный поск. Он возвращает целое число, причем , если оно равно 0, то ни одного файла не было найдено, а если положительное , то найден , по крайней мере, один файл.
Листинг 6. Поиск рабочих книг в корневом каталоге диска С
With Application. FileSearch
.LookIN = “C:\”
.FileType= msoFileTypeExcelWordBooks
If.Execute (SortByFileName._
Sortorder: msosoftorderabcending)>0 Then
Dim str As string
Str = “Найдено” & .FoundFile.Count & “
Dim I as integer
Int= I to FoundItem.Count
Str= str &. FoundFile (i) & vthcr
Next
MsgBox str
Else
MsgBox “Рабочие книги не найдены”
End if
End with
Симулирование ячеек рабочего листа
Метод Evaluate позволяет симулировать работу с ячейками или диапазонами рабочего листа без реального воплощения этих действий на рабочем листе.
Листинг 7. Симулирование ввода данных в ячейки и считывание из них значений
Public Sub Simur()
Evaluate("A1").Value = 25
Evaluate("A2").Formula = "A1^2"
MsgBox Evaluate("A2").Value
End Sub
Листинг 8 Симулирование ячеек
Public Sub stimulirovanie()
Dim firstCell As Range
Dim secondCell As Range
Set firstCell = Evaluate("A1")
Set secondCell = Evaluate("A2")
firstCell.Value = 25
secondCell.Formula = "A1^2"
MsgBox secondCell.Value
End Sub
Электронные часы в ячейке рабочего листа
Метод позволяет создать электронные часы. Для этого достаточно рекурсивно вызывать процедуру, в которой считывается текущее время. Затем оно выводится в ячейку рабочего листа, найденное время увеличивается на секунду, и уже для вычисленного нового времени устанавливается рекурсивный вызов процедуры.
Листинг 9. Электронные часы в ячейке рабочего листа. Стандартный модуль
Sub DemoClock()
DemoOnTime
End Sub
Sub DemoOnTime()
Dim newHour, newMinute, newSecond, newTime
Cells(1, 1).Value = Now
newHour = Hour(Now)
newMinute = Minute(Now)
newSecond = Second(Now)
newTime = TimeSerial(newHour, newMinute, newSecond)
Application.OnTime EarliesTime:=newTime, Procedure:="DemoOnTime"
End Sub
Доступ к отдельным ячейкам диапазона
Свойство Cells объекта Range, использованное без индексов, возвращает все ячейки диапазона, а с индексов- конкретную ячейку, специфицированную либо ее номером(один параметр), либо местоположением (два параметра).
Например, в следующем коде в диапазоне В1:С3 все положительные значения заменяются на 1, а отрицательные на -1.
Листинг 10. Все ячейки диапазона
Dim a as Range
For Each a in Range (В1:С3).Cells
If a.Value >0 Then
a.Value =1
Else if a.Value < 0 then
a.Value =-1
End if
Next
Листинг 11
Dim i As Integer Dim j As Integer
For i = 1 To Range("B1:C3").Columns.Count For j = 1 To Range("Bl:C3").Columns.Count
If Range("B1:C3")-Cells(i, j).Value > 0 Then
Range("Bl:C3").Cells(i, j).Value = 1 Elself Range("B1:C3")-Cells(i, j).Value < 0 Then
Range("B1:C3").Cells(i, j).Value = -1
End If
Next
Next
Если требуется задать абсолютное местоположение ячеек, то надо воспользоваться свойством Cells рабочего листа, например как в листинге 12.
Листинг 12. Абсолютное местоположение ячеек
Dim i As Integer Dim j As Integer For i = 2 To 3 For j = 1 To 3
If Cells(i, j).Value > 0 Then
Cells(i, j).Value = 1 Elself Cells(i, j).Value < 0 Then
Cells(i, j).Value = -1
End If
Next
Nex
Поиск значения в диапазоне
Метод Find объекта Range производит поиск специфицированной информации в указанном диапазоне и возвращает ссылку на первую ячейку, в которой требуемая информация найдена. В случае не обнаружения искомых данных, метод возвращает значение Nothing
Листинг 13. Поиск значения
Public Sub Poiskznacheni()
Dim rng As Range
Set rng = Range("A1:A10").Find(What:=17, LookIn:=xlValues)
If Not (rng Is Nothing) Then
MsgBox rng.Address
Else
MsgBox "не найдено значение"
End If
End Sub
Листинг 14 Поиск подстроки без учета регистра
Sub DemoFindNoMatchCase()
Dim rng As Range
Set rng = Range("A1:A10").Find(What:="BHV", LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
If Not (rng Is Nothing) Then
MsgBox rng.Value
Else
MsgBox "не найдено подходяшие значение"
End If
End Sub
Повторный поиск и поиск всех значений
Метод FindNext и FindPrevious объекта Range реализует повторный вызов метода Find для продолжения специфицированного поиска. Первый из методов производит поиск следующей ячейки, а второй – поиск предыдущей, удовлетворяющей объявленным критериям поиска.
FindNext (after)
FindPrevious(after)
Здесь after- необязательный параметр, указывающий на ячейку после которой надо производить поиск.
Листинг 15. Нахождение всех вхождений подстроки в данный диапазон
Sub DemoFind()
Dim firstAddress As String
Dim rng As Range
Set rng = Range("A1:A10").Find(What:="MS", LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
If Not (rng Is Nothing) Then
firstAddress = rng.Address
Do
rng.Interior.Color = RGB(255, 255, 0)
Set rng = Range("a1:a10").FindNext(rng)
Loop While Not (rng Is Nothing) And rng.Address <> firstAddress
End If
End Sub
Отсылка электронной почты
Отсылка электронной почты с данными рабочего листа может производится при помощи средств Microsoft Outlook.
Листинг 16. Отсылка электронной почты
Private Sub cmdEMail_Click()
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Set objOL = New Outlook.Application
Set objMail = objOL.CreateItem(olMailItem)
With objMail
.To = Range("B1").Value
.Body = Range("B2").Value
.Subject = Range("B3").Value
.CC = Range("B4").Value
.Display
End With
Set objMail = Nothing
Set objOL = Nothing
End Sub
Условное форматирование
Условное форматирование позволяет эффективно отображать, форматируя ячейки выборочно, основываясь на их содержании.
Листинг 17. Условное форматирование
Private Sub optAverage_Click()
Dim r As Range
Set r = Range("B1:B6")
r.FormatConditions.Delete
r.FormatConditions.Add Type:=xlExpression, _
Formula1:="=B1>=СРЗНАЧ($B$1:$B$6)"
r.FormatConditions(1).Interior.Color = RGB(255, 255, 0)
End Sub
Private Sub optMax_Click()
Dim r As Range
Set r = Range("B1:B6")
r.FormatConditions.Delete
r.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlEqual, _
Formula1:="$B$9"
With r.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = RGB(255, 0, 0)
End With
End Sub
Private Sub optValue_Click()
Dim r As Range
Set r = Range("B1:B6")
r.FormatConditions.Delete
r.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlGreaterEqual, _
Formula1:="$G$8"
r.FormatConditions(1).Interior.Color = RGB(0, 0, 255)
End Sub
Управление стилем границы диапазона и объектами Border
Свойство Border объекта Range возвращает семейство Borders, элементы которого не инкапсулируют данные об одной из граничных или диагональных линий данного диапазона. допустимыми значениями индекса семейства Borders могут быть следующие константы xlBordersIndex: lxDiagonalDown, xlEdgeLeft, xlEdgeRight, xlEdgeTop и т.д. Каждая из этих границ представляет объект Border.
Листинг 18. Управление стилем границы диапазона и объектами Border
Public Sub DemoBorders()
'Дома работает
Dim rgn As Range
Set rng = Range("A2:C2")
With rng.Borders(xlEdgeTop)
.LineStyle = xlContinuouse
.Weight = xlThick
.Color = RGB(255, 0, 0)
End With
With rng.Borders(xlEdgeBottom)
.LineStyle = xlDash
.Weight = xlMedium
.Color = RGB(0, 255, 0)
End With
End Sub
Если компоненты границы имеют они и те же параметры , то для установки их значения можно воспользоваться не элементами , а всем семейством Borders , как это, например, делается в следующей инструкции для создания границы синего цвета у выделенной области.
Пример использования объекта Shape
Примером использования объекта Shape может быть следующий код (Листинг 19) последовательно с интервалом в одну секунду выводящии различные автофигуры, а затем с такой же скоростью их удаляющий.