MyTetra Share
Делитесь знаниями!
Добавить/удалить лист (по имени)
Время создания: 31.07.2019 22:57
Раздел: !Закладки - VBA - Excel - Листы
Запись: adgaver/mytetra_base_New/master/base/1507283310t32csnhe46/text.html на raw.githubusercontent.com

''======================================================================================

''#####удаление/создание листа по имени

'Sub test_fun_ShAdd()

'Set ggg = fun_ShAdd(oWb:=ThisWorkbook, _

' strShName:="jjjj", _

' blnRecreate:=True, _

' int_Index:=ActiveSheet.Index)

'End Sub

'--------------------------------------------------------------------------------------

Function fun_ShAdd(ByVal oWb As Workbook, _

ByVal strShName As String, _

Optional ByVal blnRecreate As Boolean = False, _

Optional int_Index As Integer = 1) As Worksheet

Dim strShNameAct As String

strShNameAct = ActiveSheet.Name


'пересоздание листа сначала удаляем

If blnRecreate Then Call ShDelete(oWb, strShName) 'удалить лист


If fun_ShExists(oWb, strShName) Then 'если лист существует

Set fun_ShAdd = oWb.Sheets(strShName)

'!!!!!!очистка листа

fun_ShAdd.Cells.Clear

Else

' Set fun_ShAdd = ThisWorkbook.Sheets.Add 'Before:=Sheets(1)

Set fun_ShAdd = oWb.Sheets.Add(Before:=oWb.Sheets(int_Index))

With fun_ShAdd

' .Move Before:=Sheets(1)

.Name = strShName

End With

End If


Windows(oWb.Name).Activate

Sheets(strShNameAct).Select

End Function

'--------------------------------------------------------------------------------------

Sub ShDelete(ByVal oWb As Workbook, _

ByVal ShName As String)

On Error Resume Next

With Application

.DisplayAlerts = False

With oWb

For Each Sh In .Sheets

If Sh.Name = ShName Then Sh.Delete

Next Sh

End With

.DisplayAlerts = True

End With

End Sub

'--------------------------------------------------------------------------------------

'проверка существования листа

Function fun_ShExists(ByVal oWb As Workbook, _

ByVal strShName As String) As Boolean

With oWb

For Each Sh In .Sheets

If Sh.Name = strShName Then fun_ShExists = True: Exit Function

Next Sh

End With

End Function

'--------------------------------------------------------------------------------------

'======================================================================================

Так же в этом разделе:
 
MyTetra Share v.0.55
Яндекс индекс цитирования