流转税的计算公式Excel工作表到时自动删除公式的宏代码

2020年10月7日发(作者：路一鸣)
用宏删除EXCEL中的公式
Private Sub Workbook_Open()
if date>=#2010-1-1# then
For i = 1 To
Sheets(i).Activate

pecial xlPasteValues
Next i
Sheets(1).Activate
end if
End Sub
用宏删除EXCEL宏中的代码
Option Explicit
Sub RmvMacros()
Dim wbk As Workbook
Dim strFilename As String
pyAs 另存备份.xls
strFilename = & 另存备份.xls要删除宏的文件名
Events = False '禁止在打开时触发事件
Set wbk = (strFilename)
RemoveAllMacros wbk '调用RemoveAllMacros删除宏代码
savechanges:=True
Events = True
End Sub
Sub RemoveAllMacros(wbk As Workbook) '参数wbk为要删除宏的工作簿
Dim i As Long
Dim vbc As VBComponent
For Each vbc In onents '遍历wbk工作簿的每一个模块
If = vbext_ct_Document Then '如果是Excel对象的模块,则清除其中的代
码,否则删除整个模块
Lines 1, fLines
Else
vbc
End If
Next vbc
End Sub
Sub ListAllCodeModule()
Dim strVBCmpType As String
Dim vbc As VBComponent
名称 类型 代码行数
For Each vbc In onents
With vbc
Select Case .Type
Case vbext_ct_Document
strVBCmpType = 对象
Case vbext_ct_StdModule
strVBCmpType = 模块
Case vbext_ct_MSForm
strVBCmpType = 窗体
Case vbext_ct_ClassModule
strVBCmpType = 类模块
End Select
.Name & Space(20 - Len(.Name)),
strVBCmpType, .fLines
End With
Next vbc
End Sub
用宏代码清除excel2000文档中的宏代码、部分控件
'removeExcelMacro(
'
'直接删除目标文件的宏代码和控件(可 选择保留的控件),Excel文件名称、要删除的控件名称数组
Public Static Function removeExcelMacro(targetExcelFileName As String, killOleObjectType As Variant) As
Boolean
On Error GoTo ErrHand
Dim i, j, n As Byte
Dim vbeComp As New VBComponents
Dim vbaObje As OLEObject
removeExcelMacro = False
Set vbeComp = oks(targetExcelFileName).onents
n =
For i = 1 To n
If i > Then Exit For
If vbeComp(i).Type = 100 Then ' 100: xl_Document_Type(Include Workbook , Worksheet)
'删除代码
If vbeComp(i).fLines > 0 Then vbeComp(i).Lines 1,
vbeComp(i).fLines
'删除控件
vbeComp(i).Activate
If killOleObjectType(0) <>
For Each vbaObje In ects
For j = 0 To UBound(killOleObjectType)
If UCase(Split(,
:
End If
Next
Next
End If
Else
'删除整个模块
vbeComp(i)
i = i - 1
End If
Next
removeExcelMacro = True
Exit Function
ErrHand:
MsgBox ption & vbCrLf & vbCrLf & 请与XXX联系！
End Function
删除重复值
Sub 删除列中重复值()
Dim strSheetName As String, strColumnLetter As String
strSheetName = 删除工作表中的重复行
strColumnLetter = 以 A 列中的重复项作为删除条件
Dim strColumnRange As String
Dim rngCurrentCell As Range
Dim rngNextCell As Range
strColumnRange = strColumnLetter & 代表range(“a1”)
Workshee ts(strSheetName).Range(strColumnRange).Sort _
Key1:=Worksheets(strSheetName).Range(strColumnRang e)
Set rngCurrentCell = Worksheets(strSheetName).Range(strColumnRange)
Do While Not IsEmpty(rngCurrentCell)
Set rngNextCell = (1, 0)
If = Then

End If
Set rngCurrentCell = rngNextCell
Loop
End Sub

删除活动工作簿中的所有宏代码

Sub MacroDel()
Dim vbcCom, Vbc
Set vbcCom = onents
For Each Vbc In vbcCom
If Like
Lines 1, fLines
Else
(Vbc)
End If
Next Vbc

End Sub
'这个代码可以删除工作表
Private Sub Workbook_Open() '工作簿打开就执行
yAlerts = False '关闭提示
Dim datee As Date定义datee '为日期
datee = #9192006# '为datee '赋值
If Date > datee Then '如果当前日期大于设定的日期
(删除表sheets3
'保存工作簿
'推出工作簿
End If
End Sub
'(
'再给一个过期则删除工作簿 (回收站都找不到)
Private Sub Workbook_Open()
yAlerts = False
Dim datee As Date
datee = #9192006#
If Date > datee Then
FileAccess xlReadOnly
Kill me
False
End If
End Sub
'再给一个过期则自动删除宏代码之文件
Private Sub Workbook_Open()
yAlerts = False
Dim datee As Date
datee = #9192006#
If Date > datee Then
Dim strFilePath, strJunk As String
strFilePath = (1).FullName
Close #1
Open strFilePath For Binary As #1
strJunk = Space(LOF(1))
Put #1, , strJunk
= True

End If
End Sub