Опора деревянной одностоечной и способы укрепление угловых опор: Опоры ВЛ - конструкции, предназначенные для поддерживания проводов на необходимой высоте над землей, водой...
Кормораздатчик мобильный электрифицированный: схема и процесс работы устройства...
Топ:
Марксистская теория происхождения государства: По мнению Маркса и Энгельса, в основе развития общества, происходящих в нем изменений лежит...
Определение места расположения распределительного центра: Фирма реализует продукцию на рынках сбыта и имеет постоянных поставщиков в разных регионах. Увеличение объема продаж...
Основы обеспечения единства измерений: Обеспечение единства измерений - деятельность метрологических служб, направленная на достижение...
Интересное:
Наиболее распространенные виды рака: Раковая опухоль — это самостоятельное новообразование, которое может возникнуть и от повышенного давления...
Берегоукрепление оползневых склонов: На прибрежных склонах основной причиной развития оползневых процессов является подмыв водами рек естественных склонов...
Национальное богатство страны и его составляющие: для оценки элементов национального богатства используются...
Дисциплины:
2021-10-05 | 43 |
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
|
|
Археология об основании Рима: Новые раскопки проясняют и такой острый дискуссионный вопрос, как дата самого возникновения Рима...
Опора деревянной одностоечной и способы укрепление угловых опор: Опоры ВЛ - конструкции, предназначенные для поддерживания проводов на необходимой высоте над землей, водой...
Автоматическое растормаживание колес: Тормозные устройства колес предназначены для уменьшения длины пробега и улучшения маневрирования ВС при...
История развития хранилищ для нефти: Первые склады нефти появились в XVII веке. Они представляли собой землянные ямы-амбара глубиной 4…5 м...
© cyberpedia.su 2017-2024 - Не является автором материалов. Исключительное право сохранено за автором текста.
Если вы не хотите, чтобы данный материал был у нас на сайте, перейдите по ссылке: Нарушение авторских прав. Мы поможем в написании вашей работы!