Главная страница

Готовые макросы в VBA Excel (Миронов.) (z-lib.org). Запуск макроса с поиском ячейки 6 Запуск макроса при открытии книги 6


Скачать 1.47 Mb.
НазваниеЗапуск макроса с поиском ячейки 6 Запуск макроса при открытии книги 6
Дата26.06.2022
Размер1.47 Mb.
Формат файлаdoc
Имя файлаГотовые макросы в VBA Excel (Миронов.) (z-lib.org).doc
ТипДокументы
#615298
страница12 из 47
1   ...   8   9   10   11   12   13   14   15   ...   47

Копирование листа в книге


Sub Test()

With Application.Workbooks.Item("Test.xls")

Sheets("Test").Copy , after:=Sheets("Лист3")

End With

End Sub

Копирование листа в новую книгу (создается)


Sub Test()

With Application.Workbooks.Item("Test.xls")

Sheets("Test").Copy

End With

End Sub

Перемещение листа в книге


Sub Test()

With Application.Workbooks.Item("Test.xls")

Sheets("Test").Move , after:=Sheets("Лист3")

End With

End Sub

Перемещение нескольких листов в новую книгу


Sheets(Array("Лист1", "Лист2", "Лист3")).Select

Sheets("Лист3").Activate

Sheets(Array("Лист1", "Лист2", "Лист3")).Copy

Заменить существующий файл


Sub copy_sheet()

ShName = ActiveSheet.Name

Sheets(ShName).Copy

ActiveWorkbook.SaveAs "c:\" & ShName & ".xls"

End Sub

Чтобы не вылезало диалоговое окно надо добавить

Application.DisplayAlerts = False ' вылючаем все предупреждения

ActiveWorkbook.SaveAs "c:\" & ShName & ".xls"

Application.DisplayAlerts = True 'обратно включаем предупреждения.

«Перелистывание» книги


Sub SheetsOfBook()

Dim sheet As Object

' Отображение имен всех листов активной рабочей книги

For Each sheet In ActiveWorkbook.Sheets

MsgBox (sheet.Name)

Next

End Sub

Вставка колонтитула с именем книги, листа и текущей датой


Sub AddPageHeader()

Dim i As Integer

With ThisWorkbook

' Вставка колонтитулов на все листы рабочей книги

For i = 1 To .Worksheets.Count - 1

.Worksheets(i).PageSetup.LeftHeader = .FullName

.Worksheets(i).PageSetup.CenterHeader = Worksheets(i).Name

.Worksheets(i).PageSetup.RightHeader = Now()

Next

End With

End Sub

Существует ли лист


Function dhSheetExist(strSheetName As String) As Boolean

Dim objSheet As Object

On Error GoTo HandleError ' При ошибке перейти на HandleError

' Пытаемся получить ссылку на заданный лист

objSheet = ActiveWorkbook.Sheets(strSheetName)

' Ошибки не возникло - лист существует

dhSheetExist = True

Exit Function

HandleError:

' При попытке получить доступ к листу с заданным именем _

возникла ошибка, значит, такого листа не существует

dhSheetExist = False

End Function

Существует ли лист_2


L = 0

For Each Sheet In Worksheets

If Sheet.Name = "List12" Then

L = 1

MsgBox "List12 совпадает с расчетным листом. Переименуйте свой List12 на какое нибудь другое имя!"

End If

Next
If L = 0 Then

Worksheets.Add.Name = "List12"

Worksheets(1).Visible = True

Worksheets("List12").Visible = True

Worksheets("List12").Activate

End If

Вывод количества листов в активной книге


Sub Test()

MsgBox (Str(Application.Workbooks.Item(ActiveWorkbook.Name).Sheets.Count))

End Sub

Вывод количества листов в активной книге в виде гиперссылок


Sub SheetNamesAsHyperLinks()

Dim sheet As Worksheet

Dim cell As Range

With ActiveWorkbook

' Просмотр всех листов книги и создание гиперссылок на них _

на первом листе

For Each sheet In ActiveWorkbook.Worksheets

Set cell = Worksheets(1).Cells(sheet.Index, 1)

.Worksheets(1).Hyperlinks.Add Anchor:=cell, Address:="", _

SubAddress:="'" & sheet.Name & "'" & "!A1"

cell.Formula = sheet.Name

Next

End With

End Sub

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


Sub Test()

With Application.Workbooks.Item(ActiveWorkbook.Name)

For x = 1 To .Sheets.Count

MsgBox (Sheets.Item(x).Name)

Next x

End With

End Sub

Вывод имени и номеров листов текущей книги


Sub ShowInfo()

Dim i As Integer

' Выводим имя файла рабочей книги

Range("A1") = ActiveWorkbook.Name

' Выводим имя текущего листа

Range("B1") = ActiveSheet.Name

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

For i = 1 To ActiveWorkbook.Sheets.Count

ActiveSheet.Cells(i, 3) = i

Next i

End Sub
1   ...   8   9   10   11   12   13   14   15   ...   47


написать администратору сайта