Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
mironov_gotovye_makrosy_v_vba_excel.doc
Скачиваний:
0
Добавлен:
01.07.2025
Размер:
1.41 Mб
Скачать

Существует ли лист_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

Сделать лист невидимым

Sub Test()

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

.Sheets.Item("Лист5").Visible = False

End With

End Sub

Сколько страниц на всех листах?

Sub GetPrintPagesCount()

Dim wshtSheet As Worksheet

Dim intPagesCount As Integer

' Суммирование количества страниц, необходимых для печати всех _

листов книги

For Each wshtSheet In Worksheets

intPagesCount = intPagesCount + (wshtSheet.HPageBreaks.Count + 1) * _

(wshtSheet.VPageBreaks.Count + 1)

Next

MsgBox "Всего страниц: " & intPagesCount

End Sub

Ячейка и диапазон (столбцы и строки)

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

Sub CopyRows2()

Dim iCells As Range

For Each iCells In Range("A2:A5")

Range(iCells, iCells.Offset(, 7)).Copy

Workbooks.Add

ActiveSheet.Paste

ActiveWorkbook.SaveAs Filename:="C:\Temp\" & iCells & ".xls"

Next iCells

End Sub

Копирование столбцов на другой лист

On Error Resume Next

s = Names("sourcefilename").Value

On Error GoTo 0

If s = "" Then

sfile = "progcall234_56g"

Call get_file

s = sfile

Else

s = Mid(s, 3, Len(s) - 3)

End If

If s = "" Then Exit Sub

Workbooks.Open (s)

Dim snm As String

snm = ActiveWorkbook.Name

ncol = WorksheetFunction.CountA(Range("1:1")) ' Range("a1").SpecialCells(xlLastCell).Column

nrow = WorksheetFunction.CountA(Range("a:a")) 'Range("a1").SpecialCells(xlLastCell).Row

Range(Cells(1, 1), Cells(nrow, ncol)).Copy

Workbooks(s1).Activate

Range("a1").Activate

ActiveSheet.Paste

Application.DisplayAlerts = False

Workbooks(snm).Close

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]