VBA/Excel/Access/Word/Excel/Workbook Event — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Текущая версия на 12:47, 26 мая 2010
Содержание
- 1 Activate and deactivate events in a workbook
- 2 BeforeClose event is used to delete a custom menu
- 3 Before Save event
- 4 Cancel Close action based on the A1 value
- 5 create your own Save dialog in the event:
- 6 If you want Excel to stop prompting you to save changes you didn"t make
- 7 If you want to make sure that all changes are saved when the workbook closes
- 8 If you want to prevent users from printing only particular sheets in your workbook, use this similar code instead:
- 9 minimizes the workbook"s window:
- 10 only allow the workbook to close if the figure in A1 is between 500 and 600:
- 11 Pass value between events
- 12 Preventing Users from Inserting More Worksheets
- 13 procedure is executed when the workbook is closed
- 14 Set application key in Workbook Open event and BeforeCloseEvent
- 15 The BeforeClose event for a workbook
- 16 The BeforeSave event for a workbook
- 17 to discard any changes to the workbook
- 18 To link that tab"s command bar to a right-click in any cell, enter the following code in the private module of ThisWorkbook:
- 19 use the BeforePrint event to add information to a header or footer before the sheet is printed
- 20 Workbook activation events
- 21 Workbook_BeforePrint
- 22 Workbook Events Open: enable custom toolbar
- 23 Workbook open event
- 24 Workbook_SheetSelectionChange
Activate and deactivate events in a workbook
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
MsgBox Sh.Name
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim cbWSMenuBar As CommandBar
On Error Resume Next
Set cbWSMenuBar = Application.rumandBars("Worksheet menu bar")
cbWSMenuBar.Controls("MrExcel Programs").Delete
End Sub
Before Save event
Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lReply As Long
If SaveAsUI = True Then
lReply = MsgBox("Do you wish to save this workbook?", vbQuestion + vbOKCancel)
Cancel = (lReply = vbCancel)
If Cancel = False Then Me.Save
Cancel = True
End If
End Sub
Cancel Close action based on the A1 value
Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Sheets("Sheet1").Range("A1").Value <> True Then
Cancel = True
End If
End Sub
create your own Save dialog in the event:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Msg As String
Dim Response
Dim cbWSMenuBar As CommandBar
If Not ThisWorkbook.Saved Then
Msg = "Do you want to save the changes you made to " & Me.Name & "?"
Response = MsgBox(Msg, vbQuestion + vbYesNoCancel)
Select Case Response
Case vbYes
ThisWorkbook.Save
Case vbNo
ThisWorkbook.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
On Error Resume Next
Set cbWSMenuBar = Application.rumandBars("Worksheet menu bar")
cbWSMenuBar.Controls("MrExcel Programs").Delete
End Sub
If you want Excel to stop prompting you to save changes you didn"t make
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Me.Saved = True
End Sub
If you want to make sure that all changes are saved when the workbook closes
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not ThisWorkbook.Saved Then
ThisWorkbook.Save
End If
End Sub
If you want to prevent users from printing only particular sheets in your workbook, use this similar code instead:
Sub workbook_BeforePrint(Cancel As Boolean)
Select Case ActiveSheet.Name
Case "Sheet1", "Sheet2"
Cancel = True
MsgBox "Sorry, you cannot print this sheet from this workbook", vbInformation
End Select
End Sub
minimizes the workbook"s window:
Private Sub Workbook_Deactivate()
ThisWorkbook.Windows(1).WindowState = xlMinimized
End Sub
only allow the workbook to close if the figure in A1 is between 500 and 600:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim dProfit As Double
dProfit = ThisWorkbook.Worksheets(1).Range("A1").Value
If dProfit < 500 Or dProfit > 600 Then
MsgBox "Profit must be in the range 500 to 600"
Cancel = True
End If
End Sub
Pass value between events
Dim OldSheet As Object
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Set OldSheet = Sh
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If TypeName(Sh) = "Chart" Then
MsgBox "Sorry, you can"t activate any charts."
OldSheet.Activate
End If
End Sub
Preventing Users from Inserting More Worksheets
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.DisplayAlerts = False
MsgBox "Sorry, you cannot add any more sheets to this workbook", _
vbInformation
Sh.Delete
Application.DisplayAlerts = True
End Sub
procedure is executed when the workbook is closed
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Open Application.Path & "\test.txt" _
For Append As #1
Print #1, "Stopped " & Now
Close #1
End Sub
Set application key in Workbook Open event and BeforeCloseEvent
Private Sub Workbook_Open()
Application.OnKey "{RIGHT}", "HighlightRight"
Application.OnKey "{LEFT}", "HighlightLeft"
Application.OnKey "{UP}", "HighlightUp"
Application.OnKey "{DOWN}", "HighlightDown"
Application.OnKey "{DEL}", "DisableDelete"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "{RIGHT}"
Application.OnKey "{LEFT}"
Application.OnKey "{UP}"
Application.OnKey "{DOWN}"
Application.OnKey "{DEL}"
End Sub
The BeforeClose event for a workbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Msg As String
Dim Ans As Integer
Dim FName As String
Msg = "Would you like to make a backup of this file?"
Ans = MsgBox(Msg, vbYesNo)
If Ans = vbYes Then
FName = "F:\BACKUP\" & ThisWorkbook.Name
ThisWorkbook.SaveCopyAs FName
End If
End Sub
The BeforeSave event for a workbook
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then
MsgBox "You cannot save a copy of this workbook!"
Cancel = True
End If
End Sub
to discard any changes to the workbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Saved = True
End Sub
To link that tab"s command bar to a right-click in any cell, enter the following code in the private module of ThisWorkbook:
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim cCont As CommandBarButton
On Error Resume Next
Application.rumandBars("Cell").Controls("Sheet Index").Delete
On Error GoTo 0
Set cCont = Application.rumandBars("Cell").Controls.Add _
(Type:=msoControlButton, Temporary:=True)
With cCont
.Caption = "Sheet Index"
.OnAction = "IndexCode"
End With
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
ActiveSheet.PageSetup.RightFooter = ActiveWorkbook.FullName
End Sub
Workbook activation events
Private Sub Workbook_Activate()
ActiveWindow.WindowState = xlMaximized
End Sub
Workbook_BeforePrint
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Debug.Print Now()
Debug.Print Application.UserName
Debug.Print ActiveSheet.Name
End Sub
Workbook Events Open: enable custom toolbar
Private Sub Workbook_Open()
Application.rumandBars("My Custom Toolbar").Enabled = True
End Sub
Workbook open event
Private Sub Workbook_Open()
Dim w As Window
MsgBox "Executing the event procedure Workbook_Open."
For Each w In Windows
If w.Parent.Name <> ActiveWorkbook.Name And w.Visible Then
w.WindowState = xlMinimized
End If
Next
End Sub
Workbook_SheetSelectionChange
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Row Mod 2 = 0 Then
MsgBox "You selected the range " & Target.Address & " on " & Sh.Name, vbOKOnly, _
"SheetSelectionChange Event"
Else
MsgBox "You selected the range " & Target.Address & " on " & Sh.Name, vbOKOnly, _
"SheetSelectionChange Event"
End If
End Sub