Запуск макроса при открытии книги

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

Проверка наличия файла по указанному пути_2

Sub VerifyFileLocation1()

Dim strFileName As String

' Имя искомого файла

strFileName = "C:\Документы\primer.xls"

' Проверка наличия файла (функция Dir возвращает пустую _

строку, если по указанному пути файл обнаружить не удалось)

If Dir(strFileName) <> "" Then

MsgBox "Файл " & strFileName & " найден"

Else

MsgBox "Файл " & strFileName & " не найден"

End If

End Sub

Проверка наличия файла по указанному пути_3

Sub Check_Disk()

On Error Resume Next

If Dir("\\192.168.1.200\c\", vbSystem) <> "" Then

If Err = 52 Then

Err.Clear

MsgBox "Диска нет!", 48, "Ошибка"

Exit Sub

End If

If Err <> 0 Then

MsgBox "Произошло ошибка!", 48, "Ошибка"

Exit Sub

Else

On Error GoTo 0

MsgBox "Диск есть!", 64, ""

End If

End If

End Sub

 

Поиск нужного файла_1

Sub FileSearch()

Dim strFileName As String

Dim strFolder As String

Dim strFullPath As String

 

' Задание имени папки для поиска

strFolder = InputBox("Определите папку:")

If strFolder = "" Then Exit Sub

' Задание имени файла для поиска

strFileName = Application.InputBox("Введите имя файла:")

If strFileName = "" Then Exit Sub

' При необходимости дополняем имя папки "\"

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

 

' Полный путь файла

strFullPath = strFolder & strFileName

 

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

MsgBox "Использование команды VBA..." & vbCrLf & vbCrLf & _

dhSearchVBA(strFullPath), vbInformation, strFullPath

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

MsgBox "Использование объекта FileSearch..." & vbCrLf & _

vbCrLf & dhSearchFileSearch(strFolder, strFileName), vbInformation, _

strFullPath

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

FileSystemObject

MsgBox "Использование объекта FileSystemObject..." & vbCrLf & _

vbCrLf & dhSearchFileSystemObject(strFullPath), vbInformation, _

strFullPath

End Sub

Поиск нужного файла_2

 

Function dhSearchVBA(varFullPath As Variant) As Boolean

' Использование команды VBA

dhSearchVBA = Dir(varFullPath) <> ""

End Function

Поиск нужного файла_3

 

Function dhSearchFileSearch(varFolder As Variant, varFileName _

 As Variant) As Boolean

' Использование объекта FileSearch

With Application.FileSearch

' Создание нового поиска

.NewSearch

' Имя для поиска

    .FileName = varFileName

' Папка поиска

.LookIn = varFolder

' Собственно поиск

.Execute

dhSearchFileSearch =.FoundFiles.Count <> 0

End With

End Function

Поиск нужного файла_4

 

Function dhSearchFileSystemObject(varFullPath As Variant) As Boolean

Dim objFSObject As Object

' Использование объекта FileSystemObject

Set objFSObject = CreateObject("Scripting.FileSystemObject")

dhSearchFileSystemObject = objFSObject.FileExists(varFullPath)

End Function