关于VBA处理受保护视图表格数据的问题

antique_star

如下代码遭遇史上最哭笑不得的问题：

1. Sub Machining_CashRegister() '模块06：加工收银流水
   
2. 
   

复制代码

上面代码是打开一个文件，提取数据。
如果打开属于来源不稳定的受保护视图文件，
则用代码.Edit 启用编辑，
之后正常操作。

测试时没问题，
等我把Stop变成注释再跑一遍程序时，黄色下面无法执行。
查看目标文件，根本没有解开保护。

但是，我放一个stop(绿色位置),
手动F8往下走时，程序能够捕获未保护视图并解开启用编辑。

这是为何啊？
难道做个人性化的小工具这么难吗？
跪求大侠们出手相救！眼泪都快哭干了。
呜呜

antique_star

直接粘贴的代码看不到。上图片吧

antique_star

哦！又一次地无人问津。
我想或许是没有上传附件的原因吧，
所以专家们没法找到问题的场景。

由于时间紧迫，小弟没办法，直接上微软官网去研究了，
在无数次的测试下，终于解决了问题，
为了不让别人再遭遇此困境，现贴上我的解决方案。

1、换一种方式捕获受保护视图
    Dim WbProtect As Workbook
    If Application.ProtectedViewWindows.Count > 0 Then
      Set WbProtect = Application.ProtectedViewWindows(1).Workbook
    Else
      Set WbProtect = ActiveWorkbook
    End If

说明：上面蓝底白字部分经过测试，不管什么情况都能捕获到。百试百爽！还有用上面蓝底黑字代码获取的对象可以无限制操作数据，与受不受保护没半毛关系。
2、注意注意特别注意：受保护视图的关闭有点不一样哦。
        If Application.ProtectedViewWindows.Count > 0 Then
          Application.ProtectedViewWindows(1).Close
          Set WbProtect = Nothing
        Else
          ActiveWorkbook.Close False
          Set WbProtect = Nothing
        End If

说明：一定要用索引值关闭，如果同时打开多个受保护视图文件的话，一定要去研究索引值的顺序，我因为工具一次只需要打开一个文件，所以没去研究。解决问题最关键。


最后希望这个贴子能帮到更多的人。谢谢！
今天自己解决了难题还是很开心的，开心的像个孩子一样！
好渴望有人夸我两句哟。

igang

楼主，我和同事研究了半天的问题，终于从你这里得到了正确的答案！
之前一直失败，看了你的帖子才发现原来问题在于我们的ProtectedViewWindows前面没加Application！
非常感谢！你帮我我们的大忙！我要把这个结果写到我们的Q&A文档去！
再次感谢！！

大公臻信

我遇到相关问题，感谢你的研究成果

hhxq001

antique_star 发表于 2018-12-3 11:05
直接粘贴的代码看不到。上图片吧

没有成功，可以帮忙吗，朋友

hhxq001

antique_star 发表于 2018-12-3 11:05
直接粘贴的代码看不到。上图片吧

不会使用，可以帮一下吗，大佬

antique_star

hhxq001 发表于 2021-10-8 17:41
不会使用，可以帮一下吗，大佬

一般没事，我不会在线，偶尔有问题搜索时，才会回归一下EXCEL家庭，有什么问题请直接跟贴说明并发附件。若时间允许定尽力而为。

hhxq001

antique_star 发表于 2021-10-8 19:19
一般没事，我不会在线，偶尔有问题搜索时，才会回归一下EXCEL家庭，有什么问题请直接跟贴说明并发附件。 ...

请大侠看看，附件如下
导入不成功.zip (21.66 KB, 下载次数: 3)

2021-10-8 21:20 上传

点击文件名下载附件

原导入代码如下：只要原文件是受保护的视图文件，就无法导入成功，求可以导入成功的代码

Sub 导入某月表()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
   Set Sh = ActiveSheet
      With Application.FileDialog(msoFileDialogFilePicker) '运行后出现标准的选择文件夹对话框
       If .Show Then myPath = .SelectedItems(1) Else Exit Sub '如选中则返回=-1 / 取消未选则返回=0
     End With

    With Workbooks.Open(myPath)
    .Sheets(1).UsedRange.Copy Sh.[b3] '复制所有的单元格内容到当前表的b3单元格
     .Close False
    End With

     ActiveSheet.Range(Cells(3, 2), Cells(3, 49)).Interior.ColorIndex = 43 '第3行2列到49列改变颜色
     ActiveSheet.Columns("b:bz").EntireColumn.AutoFit '导入数据后各列根据内容自动调整列宽

  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

antique_star

试试这个，我的电脑2010测试没问题的。