使用用户表单选择和删除 Excel 个工作表
Selecting and deleting Excel sheets with userform
我在网上找到了这段代码,它几乎可以满足我的要求。目前它提供工作簿中的工作表列表(在用户窗体中)然后我可以 select 要删除哪些工作表(通过复选框)并保留未 selected 的工作表。
我希望它的工作方式与此相反:select 我想保留的工作表并删除未selected 的工作表。
Option Explicit
'thanks domenic mrexcel mvp
Private Sub SubmitButton_Click()
Dim MyArray() As Variant
Dim i As Long
Dim Cnt As Long
With Me.ListBox1
Cnt = 0
For i = 0 To .ListCount - 1
If .Selected(i) Then
Cnt = Cnt + 1
ReDim Preserve MyArray(1 To Cnt)
MyArray(Cnt) = .List(i)
End If
Next i
If Cnt > 0 Then
If Worksheets.Count > UBound(MyArray) Then
Application.DisplayAlerts = False
Worksheets(MyArray).Delete
Application.DisplayAlerts = True
Call UpdateSheetList
Else
MsgBox "A workbook must contain at least one visible sheet.", vbExclamation
End If
Else
MsgBox "Please select one or more sheets for deletion...", vbExclamation
End If
End With
End Sub
Private Sub CancelButton_Click()
'unload form
Unload Me
End Sub
Private Sub UserForm_Initialize()
Call UpdateSheetList
End Sub
Private Sub UpdateSheetList()
Dim wks As Worksheet
With Me.ListBox1
.Clear
For Each wks In Worksheets
.AddItem wks.Name
Next wks
End With
End Sub
尝试将这部分代码从 True 更改为 False
For i = 0 To .ListCount - 1
'Change the next line
If .Selected(i) = False Then
Cnt = Cnt + 1
ReDim Preserve MyArray(1 To Cnt)
MyArray(Cnt) = .List(i)
End If
Next i
我在网上找到了这段代码,它几乎可以满足我的要求。目前它提供工作簿中的工作表列表(在用户窗体中)然后我可以 select 要删除哪些工作表(通过复选框)并保留未 selected 的工作表。
我希望它的工作方式与此相反:select 我想保留的工作表并删除未selected 的工作表。
Option Explicit
'thanks domenic mrexcel mvp
Private Sub SubmitButton_Click()
Dim MyArray() As Variant
Dim i As Long
Dim Cnt As Long
With Me.ListBox1
Cnt = 0
For i = 0 To .ListCount - 1
If .Selected(i) Then
Cnt = Cnt + 1
ReDim Preserve MyArray(1 To Cnt)
MyArray(Cnt) = .List(i)
End If
Next i
If Cnt > 0 Then
If Worksheets.Count > UBound(MyArray) Then
Application.DisplayAlerts = False
Worksheets(MyArray).Delete
Application.DisplayAlerts = True
Call UpdateSheetList
Else
MsgBox "A workbook must contain at least one visible sheet.", vbExclamation
End If
Else
MsgBox "Please select one or more sheets for deletion...", vbExclamation
End If
End With
End Sub
Private Sub CancelButton_Click()
'unload form
Unload Me
End Sub
Private Sub UserForm_Initialize()
Call UpdateSheetList
End Sub
Private Sub UpdateSheetList()
Dim wks As Worksheet
With Me.ListBox1
.Clear
For Each wks In Worksheets
.AddItem wks.Name
Next wks
End With
End Sub
尝试将这部分代码从 True 更改为 False
For i = 0 To .ListCount - 1
'Change the next line
If .Selected(i) = False Then
Cnt = Cnt + 1
ReDim Preserve MyArray(1 To Cnt)
MyArray(Cnt) = .List(i)
End If
Next i