Организация документооборота с помощью "Visual Basic for Application"
Курсовой проект - Компьютеры, программирование
Другие курсовые по предмету Компьютеры, программирование
?ра
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)
firstAddress">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) последовательно с интервалом в одну секунду выводящии различные автофигуры, а затем с такой же скоростью их удаляющий.
Листинг 19. Последовательный вывод автофигур
Public Sub StarShow()
дома работает
Dim w As Integer, h As Integer, i As Integer
Dim toppos As Integer, leftpos As Integer
Dim v As Long
Dim star As Shape
w = 50: h = 50
Randomize
For i = 1 To 10
toppos = Rnd() * (ActiveWindow.UsableHeight - h)
leftpos = Rnd() * (ActiveWindow.UsableWidth - w)
Select Case (i Mod 6)
Case 0
v = msoShape4pointStar
Case 1
v = msoShape5pointStar
Case 2
v = msoShape16pointStar
Case 3
v = msoShape32pointStar
Case 5
v = msoShapeDiamond
End Select
Set star = ActiveSheet.Shapes.AddShape(v, leftpos, toppos, w, h)
star.Fill.ForeColor.SchemeColor = Int(Rnd() * 56)
Application.Wait Now + TimeValue("00:00:01")
DoEvents
Next
Application.Wait Now + TimeValue("00:00:01")
For Each star In Worksheets(1).Shapes
If Left(star.Name, 9) = "AutoShape" Then
star.Delete
DoEvents
Application.Wait Now + TimeValue("00:00:01")
End If
Next
End Sub
Подбор параметра и решение уравнения с одной не известной.
Метод GoalSeek объекта Range подбирает значение параметра (неизвестной величины), являющейся решением уравнения с одной переменой. предполагается, что уравнение приведено к следующему виду: правая часть уравнения является постоянной, не зависящей от параметра, параметр входит только в левую часть уравнения, например,
x^3-3*x-5=0
Метод GoalSeek программирует выполнение команды Сервис | подбор параметра. Этот метод вычисляет корень, использую метод последовательных приближений, результат выполнения которого, зависит от начального приближения.
Точность, с которой находиться корень и предельно допустимое число используемых для нахождения корня, устанавливается свойство MaxChange и MaxIterations объекта Application. Напримкр определение корня с точностью до 0,0001 максимум за 1000 итерации устанавливает инструкцией:
With Aplication
. MaxIterations = 1000
. MaxChange = 0.0001
End With
Метод GoalSeek возвращает значение True, если решение найдено и значение False в противном случа