excel - 将 VBA 与非活动工作表的“选择”一起使用

Question

对不起，一个潜在的“坏”标题，我不知道如何表达它。如果您有更好的措辞，请随时编辑。

这是对上一个问题的跟进。据我研究，没有解决方案，但也许我忽略了一些东西。

在具有更多工作表的工作簿中，如果我更改活动工作表的选择（手动或通过 VBA），非活动工作表的选定范围不会受到影响，因此必须以某种方式存储该值。

使用“常规命令”（set range = selection、range.select等）需要共同赞助工作表处于活动状态。这是有道理的，因为选择、选择等适用于“当前活动的选择”。

但是，非活动工作表的“选择”必须存储在某处。有没有办法获得这些值甚至操纵它们？

附录1：我认为这是隐含的：我不想更改活动工作表（否则我可以只使用常规选择命令）。

附录 2： 这不仅仅是您在屏幕上看到的内容。我想避免激活不同的工作表，因此我不必完全处理最初激活的工作表的激活 - 这是我当前的解决方案（相反，我想要一种“真正”的视图和控制器分离）。我认为“常规”API 不会提供此功能，但我认为可能还有其他解决方法。不过还是谢谢你的建议。

标签： excelvba

Answer 1

但是，非活动工作表的“选择”必须存储在某处。有没有办法获得这些值甚至操纵它们？

@Pᴇʜ 已经给了你一种方法。这是我能想到的两种方法。

1. 方式 1：遍历工作表，激活它们，然后获取Selection.Address. 我没有进行错误处理，所以If TypeName(Selection) <> "Range" Then如果选择了一个形状，你将不得不使用它来处理情况。

2. 方式2：在用户临时目录中创建当前excel文件的副本。将其重命名为.Zip. 解压缩 zip 文件。接下来转到xl\worksheetszip 文件中的文件夹并遍历每个Sheets.xml文件。从那里提取相关细节。

简易方式（方式一）

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

替代方式（方式 2） 未完全测试

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

在行动