VBA/Excel/Access/Word/Excel/Worksheet Event
Содержание
- 1 Activating Only the Used Range
- 2 BeforeDoubleClick event
- 3 BeforeRightClick event
- 4 Cancel a change in Worksheet Selection Change event
- 5 changes a cell"s interior color to red when it is double-clicked:
- 6 Change the range color in selection change event
- 7 checks each changed cell and displays a message box if the cell is within the desired range.
- 8 Create a function for Excel: Is a cell formula cell
- 9 Creating a Database Form From an Excel Worksheet in worksheet activate event
- 10 disable the events and then reenable them at the end of the procedure:
- 11 Enable Events
- 12 event procedure runs every time the worksheet recalculates
- 13 Examples of Activation Events
- 14 Example that activates cell A1 whenever the sheet is activated:
- 15 If you want the same data to appear on other sheets but not in the same cell addresses
- 16 makes use of conditional formatting and overwrites any existing conditional formatting on the sheet.
- 17 Monitoring a specific range for changes
- 18 Preventing data validation from being destroyed
- 19 SelectionChange event executes whenever the user makes a new selection on the worksheet.
- 20 Some Worksheet event are executed before the associated event occurs and have a Cancel parameter that is passed by reference.
- 21 The Change event
- 22 The event-handler procedure for the SelectionChange event
- 23 To validate user input, one possible location for the code is the SheetChange() event procedure of the Workbook object.
- 24 trace worksheet activate event
- 25 Track worksheet change event
- 26 Use a Change event to take what is in the cell and insert the colon for you
- 27 Use Event Parameters to cancel an event
- 28 Using the Change Event to Respond to Worksheet Changes
- 29 Validating data entry in Worksheet change event
- 30 With each range selection you make in the worksheet, the background color of the selection will turn blue.
- 31 Worksheet_Calculate()
- 32 Worksheet Change Events
- 33 Worksheet_SelectionChange(ByVal Target As Range)
Activating Only the Used Range
<source lang="vb">
Private Sub Worksheet_Activate( )
Me.ScrollArea = Range(Me.UsedRange, Me.UsedRange(2,2)).Address
End Sub
</source>
BeforeDoubleClick event
<source lang="vb">
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Excel.Range, Cancel As Boolean) Target.Font.Bold = Not Target.Font.Bold Cancel = True
End Sub
</source>
BeforeRightClick event
<source lang="vb">
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
If IsNumeric(Target) And Not IsEmpty(Target) Then Application.Dialogs(xlDialogFormatNumber).Show Cancel = True End If
End Sub
</source>
Cancel a change in Worksheet Selection Change event
<source lang="vb">
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Forbidden As Range Set Forbidden = Union(Range("B10:F20"), Range("H10:L20")) If Intersect(Target, Forbidden) Is Nothing Then Exit Sub Range("A1").Select MsgBox "You can"t select cells in " & Forbidden.Address, vbCritical
End Sub
</source>
changes a cell"s interior color to red when it is double-clicked:
<source lang="vb">
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean) Dim myColor As Integer Target.Interior.ColorIndex = 3
End Sub
</source>
Change the range color in selection change event
<source lang="vb"> Sub Worksheet_SelectionChange(ByVal Target As Range) Rows.Interior.ColorIndex = xlColorIndexNone Target.EntireColumn.Interior.ColorIndex = 36 Target.EntireRow.Interior.ColorIndex = 36 End Sub </source>
checks each changed cell and displays a message box if the cell is within the desired range.
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Set VRange = Range("InputRange") For Each cell In Target If Union(cell, VRange).Address = VRange.Address Then Msgbox "The changed cell is in the input range." End if Next cell
End Sub
</source>
Create a function for Excel: Is a cell formula cell
<source lang="vb"> Function IsFormula(Check_Cell As Range) IsFormula = Check_Cell.HasFormula End Function
=IsFormula(A1)
</source>
Creating a Database Form From an Excel Worksheet in worksheet activate event
<source lang="vb">
Private Sub Worksheet_Activate()
Dim dbNorthwind As DAO.Database Dim rsCategories As DAO.Recordset Dim dbpath As String dbpath = CurrentPath & "\mydb.mdb" Set dbNorthwind = OpenDatabase(dbpath) Set rsCategories = dbNorthwind.OpenRecordset( _ "Categories", dbOpenTable) With rsCategories If Not .BOF Then .MoveFirst Cells(3, 3).Value = .Fields(1).Value "Name Cells(5, 3).Value = .Fields(2).Value "Description End With
End Sub
</source>
disable the events and then reenable them at the end of the procedure:
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False Range("A1").Value = Target.Value Application.EnableEvents = True
End Sub
</source>
Enable Events
<source lang="vb"> Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Range("A1").Value = 100 Application.EnableEvents = True End Sub </source>
event procedure runs every time the worksheet recalculates
<source lang="vb"> Private Sub Worksheet_Calculate() Dim dProfit As Double dProfit = Me.Range("A1").Value If dProfit > 600 Then MsgBox "Profit has risen to " & Format(dProfit, "#,##0.0"), vbExclamation ElseIf dProfit < 500 Then MsgBox "Profit has fallen to " & Format(dProfit, "#,##0.0"), vbCritical End If End Sub </source>
Examples of Activation Events
<source lang="vb">
Private Sub Worksheet_Activate()
MsgBox "You just activated " & ActiveSheet.Name
End Sub
</source>
Example that activates cell A1 whenever the sheet is activated:
<source lang="vb">
Private Sub Worksheet_Activate()
Range("A1").Activate
End Sub Worksheet Deactivate event
Private Sub Worksheet_Deactivate() MsgBox "You must stay on Sheet1" Sheets("Sheet1").Activate
End Sub
</source>
If you want the same data to appear on other sheets but not in the same cell addresses
<source lang="vb">
Private Sub worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("MyRange"), Target) Is Nothing Then With Range("MyRange") .Copy Destination:=Sheets("Sheet3").Range("A1") .Copy Destination:=Sheets("Sheet1").Range("D10") End With End If
End Sub
</source>
makes use of conditional formatting and overwrites any existing conditional formatting on the sheet.
<source lang="vb">
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Integer On Error Resume Next iColor = Target.Interior.ColorIndex If iColor < 0 Then iColor = 36 Else iColor = iColor + 1 End If If iColor = Target.Font.ColorIndex Then iColor = iColor + 1 Cells.FormatConditions.Delete With Range("A" & Target.Row, Target.Address) .FormatConditions.Add Type:=2, Formula1:="TRUE" .FormatConditions(1).Interior.ColorIndex = iColor End With With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & _ Target.Offset(-1, 0).Address) .FormatConditions.Add Type:=2, Formula1:="TRUE" .FormatConditions(1).Interior.ColorIndex = iColor End With
End Sub
</source>
Monitoring a specific range for changes
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim VRange As Range Set VRange = Range("InputRange") If Union(Target, VRange).Address = VRange.Address Then Msgbox "The changed cell is in the input range." End if
End Sub
</source>
Preventing data validation from being destroyed
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Range)
Dim VT As Long On Error Resume Next VT = Range("A1").Validation.Type If Err.Number <> 0 Then Application.Undo MsgBox "canceled." End If
End Sub
</source>
SelectionChange event executes whenever the user makes a new selection on the worksheet.
<source lang="vb">
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Cells.Interior.ColorIndex = xlNone With ActiveCell .EntireRow.Interior.ColorIndex = 36 .EntireColumn.Interior.ColorIndex = 36 End With
End Sub
</source>
Some Worksheet event are executed before the associated event occurs and have a Cancel parameter that is passed by reference.
<source lang="vb"> Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _ Cancel As Boolean) Cancel = True End Sub </source>
The Change event
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then If Not IsNumeric(Target) Then MsgBox "Enter a number in cell A1." Range("A1").ClearContents Range("A1").Activate End If End If
End Sub
</source>
The event-handler procedure for the SelectionChange event
<source lang="vb">
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Union(Target, Range("ToolbarRange")).Address = Range("ToolbarRange").Address Then CommandBars("myBar").Visible = True Else CommandBars("myBar").Visible = False End If
End Sub
</source>
To validate user input, one possible location for the code is the SheetChange() event procedure of the Workbook object.
<source lang="vb">
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox (Sh.Name & " "& Target.Address)
End Sub
</source>
trace worksheet activate event
<source lang="vb">
Sub Worksheet_Activate()
Dim msgOutput As String msgOutput = "This worksheet is " & Workheets(2).Name MsgBox (msgOutput)
End Sub
</source>
Track worksheet change event
<source lang="vb">
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim msgOutput As String msgOutput = "The name of this worksheet is " & Worlsheets(1).Name MsgBox (msgOutput) Worksheets(1).Select
End Sub
</source>
Use a Change event to take what is in the cell and insert the colon for you
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ThisColumn As Integer Dim UserInput As String, NewInput As String ThisColumn = Target.Column If ThisColumn < 3 Then UserInput = Target.Value If UserInput > 1 Then NewInput = Left(UserInput, Len(UserInput) - 2) & ":" & _ Right(UserInput, 2) Application.EnableEvents = False Target = NewInput Application.EnableEvents = True End If End If
End Sub
</source>
Use Event Parameters to cancel an event
<source lang="vb">
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub
</source>
Using the Change Event to Respond to Worksheet Changes
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Address Case "$B$1" Debug.Print Target.Value Case "$B$2" Debug.Print Target.Value End Select
End Sub
</source>
Validating data entry in Worksheet change event
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim VRange As Range, cell As Range Dim Msg As String Dim ValidateCode As Variant Set VRange = Range("A1:C4") For Each cell In Target If Union(cell, VRange).Address = VRange.Address Then ValidateCode = EntryIsValid(cell) If ValidateCode = True Then Exit Sub Else Debug.Print "Cell " & cell.Address(False, False) & ":" & ValidateCode Application.EnableEvents = False cell.ClearContents cell.Activate Application.EnableEvents = True End If End If Next cell
End Sub Function EntryIsValid(cell) As Variant
If cell = "" Then EntryIsValid = True Exit Function End If If Not IsNumeric(cell) Then EntryIsValid = "Non-numeric entry." Exit Function End If If CInt(cell) <> cell Then EntryIsValid = "Integer required." Exit Function End If If cell < 1 Or cell > 12 Then EntryIsValid = "Valid values are between 1 and 12." Exit Function End If EntryIsValid = True
End Function
</source>
With each range selection you make in the worksheet, the background color of the selection will turn blue.
<source lang="vb">
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Interior.Color = vbBlue
End Sub
</source>
Worksheet_Calculate()
<source lang="vb">
Private Sub Worksheet_Calculate()
Select Case Range("C3").Value Case Is < Range("C4").Value SetArrow 10, msoShapeDownArrow Case Is > Range("C4").Value SetArrow 3, msoShapeUpArrow End Select
End Sub Private Sub SetArrow()
" The following code is added to remove the prior shapes For Each sh In ActiveSheet.Shapes If sh.Name Like "*Arrow*" Then sh.Delete End If Next sh ActiveSheet.Shapes.AddShape(20, 17.25, 43.5, 5, 10).Select With Selection.ShapeRange With .Fill .Visible = msoTrue .Solid .ForeColor.SchemeColor = 2 .Transparency = 0# End With With .Line .Weight = 0.75 .DashStyle = msoLineSolid .Style = msoLineSingle .Transparency = 0# .Visible = msoTrue .ForeColor.SchemeColor = 64 .BackColor.RGB = RGB(255, 255, 255) End With End With
End Sub
</source>
Worksheet Change Events
<source lang="vb">
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
MsgBox "Range " & Target.Address & " was changed."
End Sub
</source>
Worksheet_SelectionChange(ByVal Target As Range)
<source lang="vb">
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("MyRange"), Target) Is Nothing Then Sheets(Array("Sheet5", "Sheet3", "Sheet1")).Select Else Me.Select End If
End Sub
</source>