в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:16Z

1 версия

Новая страница

==Activate and deactivate events in a workbook==



<source lang="vb">

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
MsgBox Sh.Name
End Sub
</source>

==BeforeClose event is used to delete a custom menu==



<source lang="vb">

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
</source>

==Before Save event==



<source lang="vb">

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
</source>

==Cancel Close action based on the A1 value==



<source lang="vb">

Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Sheets("Sheet1").Range("A1").Value <> True Then
Cancel = True
End If
End Sub
</source>

==create your own Save dialog in the event:==



<source lang="vb">

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
</source>

==If you want Excel to stop prompting you to save changes you didn"t make==



<source lang="vb">

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Me.Saved = True
End Sub
</source>

==If you want to make sure that all changes are saved when the workbook closes==



<source lang="vb">

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not ThisWorkbook.Saved Then
ThisWorkbook.Save
End If
End Sub
</source>

==If you want to prevent users from printing only particular sheets in your workbook, use this similar code instead:==



<source lang="vb">

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
</source>

==minimizes the workbook"s window:==



<source lang="vb">

Private Sub Workbook_Deactivate()
ThisWorkbook.Windows(1).WindowState = xlMinimized
End Sub
</source>

==only allow the workbook to close if the figure in A1 is between 500 and 600:==



<source lang="vb">

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
</source>

==Pass value between events==



<source lang="vb">

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
</source>

==Preventing Users from Inserting More Worksheets==



<source lang="vb">

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
</source>

==procedure is executed when the workbook is closed==



<source lang="vb">

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Open Application.Path & "\test.txt" _
For Append As #1
Print #1, "Stopped " & Now
Close #1
End Sub
</source>

==Set application key in Workbook Open event and BeforeCloseEvent==



<source lang="vb">

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
</source>

==The BeforeClose event for a workbook==



<source lang="vb">

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
</source>

==The BeforeSave event for a workbook==



<source lang="vb">

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
</source>

==to discard any changes to the workbook==



<source lang="vb">

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Saved = True
End Sub
</source>

==To link that tab"s command bar to a right-click in any cell, enter the following code in the private module of ThisWorkbook:==



<source lang="vb">

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
</source>

==use the BeforePrint event to add information to a header or footer before the sheet is printed==



<source lang="vb">

Private Sub Workbook_BeforePrint(Cancel As Boolean)
ActiveSheet.PageSetup.RightFooter = ActiveWorkbook.FullName
End Sub
</source>

==Workbook activation events==



<source lang="vb">

Private Sub Workbook_Activate()
ActiveWindow.WindowState = xlMaximized
End Sub
</source>

==Workbook_BeforePrint==



<source lang="vb">

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Debug.Print Now()
Debug.Print Application.UserName
Debug.Print ActiveSheet.Name
End Sub
</source>

==Workbook Events Open: enable custom toolbar==



<source lang="vb">

Private Sub Workbook_Open()
Application.rumandBars("My Custom Toolbar").Enabled = True
End Sub
</source>

==Workbook open event==



<source lang="vb">

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
</source>

==Workbook_SheetSelectionChange==



<source lang="vb">

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
</source>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Excel/Workbook Event - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия