|
|
Готовые макросы в VBA Excel, Миронов. Готовые макросы в vba excel, Миронов Глава Макросы 9
Глава 1. Макросы
' Sub GotoFixedCell:
' Делает активной ячейку, содержащую значение vVariant на
' рабочем листе sSheetName в активной рабочей книге.
'
' Note: Содержимое ячеек интерпретируется как 'значение'!
'
Public Sub GotoFixedCell(vValue As Variant, sSheetName As String)
Dim c As Range, cStart As Range, cForFind As Range
Dim i As Integer
On Error GoTo errhandle:
Set cForFind = Worksheets(sSheetName).Cells ' Диапазон поиска
With cForFind
Set c = .Find(What:=vValue, After:=ActiveCell, LookIn:=xlValues, _
LookAt:= xlРart, SearchOrder:=xlByRows,_
SearchDirection:=xlNext, MatchCase:=False)
Set cStart = c
While Not c Is Nothing
Set c = .FindNext(c)
If c.Address = cStart.Address Then
c.Select
Exit Sub
End If
Wend
End With
Exit Sub
errНandle:
MsgBox Err.Descriрtion, vbExclamation, "Error #" & Err.Number
End Sub
Запуск макроса при открытии книги
Sub Auto_Oрen()
Запуск макроса при вводе в ячейку «2»
Private Sub Worksheet_Change(ByVal Target As Range)
Dim w As Object
'On Error Resume Next
If Range("A1").Value = 2 Then
MsgBox "Ох! Значение ячейки стало равным 2-м!"
MsgBox "Я попробую сейчас открыть модуль с процедурой, которая все это делает!"
Application.VBE.MainWindow.SetFocus
Application.VBE.Windows(1).SetFocus
SendKeys "{F7}", True
End If
End Sub
Запуск макроса при нажатии «Ентер»
в модуле листа
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.OnKey "{
}", "StartEnter"
End Sub
в модуле книги
Sub StartEnter()
MsgBox ("sadfsdfsf")
End Sub
Добавить в панель свою вкладку «Надстройки» (Формат ячейки)
Код в модуле рабочего листа
Sub Worksheet_Change(ByVal Target As Excel.Range)
Call UpdateToolbar
End Sub
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Call UpdateToolbar
End Sub
Листинг 2.43. Код в стандартном модуле
Sub FastChangeNumberFormat()
Dim bar As CommandBar
Dim button As CommandBarButton
' Удаление существующей панели инструментов (если она есть)
On Error Resume Next
CommandBars("Числовой формат").Delete
On Error GoTo 0
' Формирование новой панели
Set bar = CommandBars.Add
With bar
.Name = "Числовой формат"
.Visible = True
End With
' Создание кнопки
Set button = CommandBars("Числовой формат").Controls.Add _
(Type:=msoControlButton)
With button
.Caption = ""
.OnAction = "ChangeNumFormat"
.TooltipText = "Щелкните для изменения числового формата"
.Style = msoButtonCaption
End With
' Обновление созданной панели инструментов
Call UpdateToolbar
End Sub
Sub UpdateToolbar()
' Обновление панели инструментов (если она создана)
On Error Resume Next
' Изменение заголовка кнопки (на название формата выделенной ячейки)
CommandBars("Числовой формат").Controls(1).Caption = _
ActiveCell.NumberFormat
End Sub
Sub ChangeNumFormat()
' Отображение диалогового окна изменения формата ячейки
Application.Dialogs(xlDialogFormatNumber).Show
Call UpdateToolbar
End Sub
Глава 2. Работа с файлами (т.е.обмен данными с ТХТ, RTF, XLS и т.д.) Проверка наличия файла по указанному пути_1
Sub VerifyFileLocation()
Dim strFileName As String
Dim strFileTitle As String
' Имя и путь искомого файла
strFileTitle = "primer.xls"
strFileName = "C:\Документы\primer.xls"
' Проверка наличия файла (функция Dir возвращает пустую _
строку, если по указанному пути файл обнаружить не удалось)
If Dir(strFileName) <> "" Then
MsgBox "Файл " & strFileTitle & " найден"
Else
MsgBox "Файл " & strFileTitle & " не найден"
End If
End Sub
|
|
|
Скачать 1.35 Mb.