Reputation: 1120
Sorry for a potential "bad" title, I wasn't sure how to phrase it. Feel free to edit if you have a better wording.
This is a follow-up on a previous question. As far as I researched there is no solution but maybe I overlooked something.
In a workbook with more then worksheet if I change the selection of the active worksheet (manually or via VBA) the selected range of the non-active sheets won't be affected, so the value must be stored somehow.
Using "the regular commands" (set range = selection
, range.select
, etc.) requires the cosponsoring sheets to be active. This makes sense since the selection, select etc. applies to the "currently active selection".
But still, the "selection" of non active sheet must be stored somewhere. Is there a way to get those values or even manipulate them?
Appendix1: I thought this was implied: I don't want to change the active sheet (otherwise I could just use the regular select commands).
Appendix2: It's not just about what you see on the screen. I want to avoid activating a different sheet so I don't have to have to handle the activation of the initially activated sheet altogether - this is my current solution (instead I want sort of a "true" separation of view and controller). I don't think the "regular" API will provide this, but I though there might be some other work around. But thanks for your suggestion anyway.
Upvotes: 2
Views: 2276
Reputation: 149315
But still, the "selection" of non active sheet must be stored somewhere. Is there a way to get those values or even manipulate them?
@Pᴇʜ already has given you 1 way. Here are two ways I can think of.
Way 1: Loop through the sheets, activate them and then get the Selection.Address
. I have not done error handling so you will have to use If TypeName(Selection) <> "Range" Then
to handle situations if say a shape is selected.
Way 2: Create a copy of the current excel file in user temp directory. Rename it to .Zip
. Unzip the zip file. Next go to xl\worksheets
folder in the zip file and loop through each Sheets.xml
file. Extract the relevant detail from there.
Easy Way (Way 1)
Option Explicit
Sub WayOne()
Dim ws As Worksheet
Dim msg As String
For Each ws In ThisWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
ws.Activate
msg = msg & vbNewLine & ws.Name & " -- " & Selection.Address
End If
Next ws
Msgbox Mid(msg, 2)
End Sub
Alternative Way (Way 2) Not completely tested
Option Explicit
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Sub Way2()
Dim thisFileName As String
Dim FileNameFolder As String
Dim oldFileName As String
Dim newFileName As Variant
Dim UnzipFolder As String
Dim tmpName As String
'~~> Get a unique mame for the temp folder and zip file
tmpName = Format(Now, "ddmmyyyyhhmmss")
'~~> Get this workbooks name
thisFileName = ThisWorkbook.Name
'~~> Temp folder
FileNameFolder = TempPath & tmpName
'~~> Make the folder
MkDir FileNameFolder
DoEvents
'~~> Folder to unzip files in the above folder
UnzipFolder = FileNameFolder & "\UnzipFolder"
'~~> Make the folder
MkDir UnzipFolder
DoEvents
'~~> Name of file with which the current file will saved
oldFileName = FileNameFolder & "\" & thisFileName
'~~> Name of the zip file
newFileName = FileNameFolder & "\" & tmpName & ".zip"
'~~> Save a copy of this folder
ThisWorkbook.SaveCopyAs (oldFileName)
DoEvents
'~~> Rename the file
Name oldFileName As newFileName
'~~> Unzip the files
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(UnzipFolder & "\").CopyHere oApp.Namespace(newFileName).items
'~~> Identify our working folder
Dim Workingfolder As String
Workingfolder = UnzipFolder & "\xl\worksheets\"
Dim StrFile As String
StrFile = Dir(Workingfolder & "\*.xml")
Dim MyData As String
Dim SheetName As String
Dim rngaddr As String
'~~> Loop through the xml files to extract relevant details
Do While Len(StrFile) > 0
Open Workingfolder & StrFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
'~~> Get Sheet name
SheetName = GetValue(MyData, "N")
'~~> Get Range address
rngaddr = GetValue(MyData, "R")
Debug.Print SheetName & " - " & rngaddr
StrFile = Dir
Loop
'~~> Cleanup. Delete the temp folder
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder FileNameFolder
End Sub
Private Function GetValue(dat As String, opt As String) As String
Dim Delim As String
Dim tmpValue As String
If opt = "N" Then
'~~> For sheet name
Delim = "<sheetPr codeName="""
Else
'~~> For multiple cell address
Delim = "<selection sqref="""
If InStr(1, dat, Delim) = 0 Then
'~~> For Single cell address
Delim = "<selection activeCell="""
End If
End If
If InStr(1, dat, Delim) Then
tmpValue = Split(dat, Delim)(1)
tmpValue = Split(tmpValue, Chr(34))(0)
Else
tmpValue = "A1"
End If
GetValue = tmpValue
End Function
'~~> Get user temp path
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
In Action
Upvotes: 4
Reputation: 57733
I guess this is only possible with a workaround, because per definition Selection
only exists once in Excel, because it is Application.Selection
and we have no access to the hidden value were Excel remembers this for each worksheet.
Write into ThisWorkbook
scope:
Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
SaveAddress Selection
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
SaveAddress Target
End Sub
Write into a module:
Option Explicit
Public SelectionAddresses As Object
Public Sub SaveAddress(ByVal Target As Range)
On Error GoTo CREATE_DICTIONARY
If SelectionAddresses.Exists(Target.Parent.Name) Then
SelectionAddresses(Target.Parent.Name) = Target.Address
Else
SelectionAddresses.Add Target.Parent.Name, Target.Address
End If
Exit Sub
CREATE_DICTIONARY:
If Err.Number = 91 Then
Set SelectionAddresses = CreateObject("Scripting.Dictionary")
InitializeAddresses
Resume
Else
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End If
End Sub
Public Sub ListAddresses()
Dim Key As Variant
For Each Key In SelectionAddresses
Debug.Print Key, SelectionAddresses(Key)
Next Key
End Sub
Public Sub InitializeAddresses()
Dim ActWs As Worksheet
Set ActWs = ActiveSheet
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
Next ws
ActWs.Activate
Application.ScreenUpdating = True
End Sub
Public Function GetSelectionAddressOfSheet(ByVal SheetName As String) As String
On Error GoTo NOT_FOUND
If SelectionAddresses.Exists(SheetName) Then
GetSelectionAddressOfSheet = SelectionAddresses(SheetName)
Else
GoTo NOT_FOUND
End If
Exit Function
NOT_FOUND:
GetSelectionAddressOfSheet = "not found" 'or vbNullString
On Error GoTo 0
End Function
This will save the selection address of every sheet into a dictionary SelectionAddresses
where you can then read it from. Eg with
Debug.Print GetSelectionAddressOfSheet("Sheet2")
You might want to use an additional
Private Sub Workbook_Open()
InitializeAddresses
End Sub
So the dictionary gets initialized immediately after opening the workbook.
Upvotes: 2