Page tree

Welcome to FreeSoftwareServers Confluence Wiki

Skip to end of metadata
Go to start of metadata

https://stackoverflow.com/questions/64670652/make-sheetselectionchange-operate-on-a-different-workbook/64670891#64670891

https://docs.microsoft.com/en-us/office/troubleshoot/excel/create-application-level-event-handler

Module:

Public myobject As New AppEvent_SheetSelectionChange
Public ReadMode As Boolean
Public Sub ReadModeToggle(control As IRibbonControl)
 Call ReadModeToggle_Sub
End Sub
Public Sub ReadModeToggle_Sub()
Set myobject.appevent = Application
 If ReadMode = False Then
  Call ReadModeEnable_Sub
 ElseIf ReadMode = True Then
  Call ReadModeDisable_Sub
 End If
 Debug.Print "ReadMode = " & ReadMode
End Sub
Public Sub ReadModeEnable_Sub()
 ReadMode = True
End Sub
Public Sub ReadModeDisable_Sub()
 ReadMode = False
 Call HighlightXYAxis(0)
End Sub
Public Sub HighlightXYAxis(ColorCode As Integer)

 Call DisableAlerts
 
 Dim XRng As Range, YRng As Range, ShUsedRng As Range, rcell As Range
 Dim XlRow As Integer, YlCol As Integer ', ColorCode As Integer
 
 'ColorCode = 37
  
 XlRow = Get_lRow(ActiveSheet)
 YlCol = Get_lCol(ActiveSheet)
 
 For Each rcell In Rows(1).Cells
  If rcell.Interior.ColorIndex = ColorCode Then
   Set YRng = Range(Cells(1, rcell.Column), Cells(XlRow, rcell.Column))
   YRng.Interior.ColorIndex = 0
   If rcell.Offset(0, -1).Interior.ColorIndex <> 0 Then
    rcell.Interior.ColorIndex = rcell.Offset(0, -1).Interior.ColorIndex
   End If
   Exit For
  End If
 Next rcell
 
 For Each rcell In Columns(1).Cells
  If rcell.Interior.ColorIndex = ColorCode Then
   Set XRng = Range(Cells(rcell.Row, 1), Cells(rcell.Row, YlCol))
   XRng.Interior.ColorIndex = 0
   Exit For
  End If
 Next rcell
 
 Set XRng = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, YlCol))
 XRng.Interior.ColorIndex = ColorCode
 Set YRng = Range(Cells(1, ActiveCell.Column), Cells(XlRow, ActiveCell.Column))
 YRng.Interior.ColorIndex = ColorCode
 
 Call EnableAlerts
 
End Sub

Class Module:

Public WithEvents appevent As Application
Private Sub AppEvent_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim Count As Integer
Count = 0
While Count < 1 And ReadMode = True
Count = 2
 Call HighlightXYAxis(37)
Wend
End Sub
  • No labels