Таксономические единицы (категории) растений: Каждая система классификации состоит из определённых соподчиненных друг другу...
Историки об Елизавете Петровне: Елизавета попала между двумя встречными культурными течениями, воспитывалась среди новых европейских веяний и преданий...
Топ:
Характеристика АТП и сварочно-жестяницкого участка: Транспорт в настоящее время является одной из важнейших отраслей народного хозяйства...
Характеристика АТП и сварочно-жестяницкого участка: Транспорт в настоящее время является одной из важнейших отраслей народного...
Отражение на счетах бухгалтерского учета процесса приобретения: Процесс заготовления представляет систему экономических событий, включающих приобретение организацией у поставщиков сырья...
Интересное:
Мероприятия для защиты от морозного пучения грунтов: Инженерная защита от морозного (криогенного) пучения грунтов необходима для легких малоэтажных зданий и других сооружений...
Берегоукрепление оползневых склонов: На прибрежных склонах основной причиной развития оползневых процессов является подмыв водами рек естественных склонов...
Принципы управления денежными потоками: одним из методов контроля за состоянием денежной наличности является...
Дисциплины:
2021-10-05 | 41 |
5.00
из
|
Заказать работу |
|
|
Sub IsSheetProtected()
' Проверка, установлена ли защита на содержимое листа
If Worksheets(1).ProtectContents Then
MsgBox "Защита листа включена"
Else
MsgBox "Защита листа не включена"
End If
End Sub
Список отсортированных листов
Sub SortSheets2()
Dim astrSheetNames() As String ' Массив для хранения имен листов
Dim intSheetCount As Integer
Dim i As Integer
Dim objActiveSheet As Object
' Если нет активной рабочей книги - закрыть процедуру
If ActiveWorkbook Is Nothing Then Exit Sub
' Проверка защищенности структуры рабочей книги
If ActiveWorkbook.ProtectStructure Then
' Сортировка листов защищенной рабочей книги невозможна
MsgBox "Структура книги " & ActiveWorkbook.Name & _
" защищена. Сортировка листов невозможна.", _
vbCritical
Exit Sub
End If
' Сохраняем ссылку на активный лист книги
Set objActiveSheet = ActiveSheet
' Отключение сочетания клавиш Ctrl+Pause Break
Application.EnableCancelKey = xlDisabled
' Функция обновления экрана отключается
Application.ScreenUpdating = False
With ActiveWorkbook
' Cоздаем новый лист "Сортировка" (если он еще не создан)
On Error Resume Next
If.Sheets("Сортировка") Is Nothing Then
.Sheets.Add.Name = "Сортировка"
End If
On Error GoTo 0
' Размещение данных на листе "Сортировка" (в столбец "A")
intSheetCount =.Sheets.Count
For i = 1 To intSheetCount
.Sheets("Сортировка").Cells(i, 1) =.Sheets(i).Name
Next i
' Сортировка данных в ячейках листа "Сортировка" по содержимому _
столбца A
.Sheets("Сортировка").Range("A1").Sort _
Key1:=.Sheets("Сортировка").Range("A1"), _
Order1:=xlAscending
' Заполнение массива имен отсортированными строками
ReDim astrSheetNames(1 To intSheetCount)
For i = 1 To intSheetCount
astrSheetNames(i) =.Sheets("Сортировка").Cells(i, 1)
Next i
' Перемещение листов
For i = 1 To intSheetCount
.Sheets(astrSheetNames(i)).Move.Sheets(i)
Next i
End With
' Переход на исходный рабочий лист
objActiveSheet.Activate
' Включаем обновление экрана
|
Application.ScreenUpdating = True
' Включение сочетания клавиш Ctrl+Pause Break
Application.EnableCancelKey = xlInterrupt
End Sub
Создать новый лист_1
Sub NewSheet()
Worksheets.Add
End Sub
‘Sub Tes2t()
‘With Application.Workbooks.Item(ActiveWorkbook.Name)
‘Sheets.Add
‘End With
‘End Sub
‘Dim ExNew As Worksheet
‘Set ExNew = ActiveWorkbook.Worksheets.Add
‘ExNew.Name = "Имя Листа"
Создать новый лист_2
Worksheets.Add.Name = "List12345.xls"
Удаление листов в зависимости от даты
' Function DelSheetByDate
' Удаляет рабочий лист sSheetName в активной рабочей книге,
' если дата dDelDate уже наступила
' В случае успеха возвращает True, иначе - False
Public Function DelSheetByDate(sSheetName As String, _
dDelDate As Date) As Boolean
On Error GoTo errHandle
DelSheetByDate = False
' Проверка даты
If dDelDate <= Date Then
' Не выводить подтверждение на удаление
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(sSheetName).Delete
DelSheetByDate = True
Application.DisplayAlerts = True
End If
Exit Function
errHandle:
MsgBox Err.Description, vbCritical, "Ошибка №" & Err.Number
End Function
Копирование листа в книге
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
|
|
Эмиссия газов от очистных сооружений канализации: В последние годы внимание мирового сообщества сосредоточено на экологических проблемах...
Своеобразие русской архитектуры: Основной материал – дерево – быстрота постройки, но недолговечность и необходимость деления...
Наброски и зарисовки растений, плодов, цветов: Освоить конструктивное построение структуры дерева через зарисовки отдельных деревьев, группы деревьев...
Папиллярные узоры пальцев рук - маркер спортивных способностей: дерматоглифические признаки формируются на 3-5 месяце беременности, не изменяются в течение жизни...
© cyberpedia.su 2017-2024 - Не является автором материалов. Исключительное право сохранено за автором текста.
Если вы не хотите, чтобы данный материал был у нас на сайте, перейдите по ссылке: Нарушение авторских прав. Мы поможем в написании вашей работы!