vba-禁止重命名sheet
Dim aa, bbPrivate Sub Workbook_Open()
aa = ActiveSheet.Name
bb = ActiveSheet.Index
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
aa = ActiveSheet.Name
bb = ActiveSheet.Index
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
On Error Resume Next
If Sheets(bb).Name <> aa Then Sheets(bb).Name = aa
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object,
ByVal Target As Range)
On Error Resume Next
If Sheets(bb).Name <> aa Then Sheets(bb).Name = aa
End Sub建立一个搜索
Sub 查找指定值()
Dim result As String, str1 As String, str2 As String
Dim c As Range
result = Application.InputBox(prompt:="请输入要查找的值：", Title:="查找", Type:=2)
If result = "False" Or result = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveSheet.Cells
Set c = .Find(result, , , xlWhole, xlByColumns, xlNext, False)
If Not c Is Nothing Then
str1 = c.Address
Do
c.Interior.ColorIndex = 4 '加亮显示
str2 = str2 & c.Address & vbCrLf
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> str1
End If
End With
MsgBox "查找到指定数据在以下单元格中：" & vbCrLf & vbCrLf _
& str2, vbInformation + vbOKOnly, "查找结果"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
页:
[1]