VBA中如何打开一个文件夹内的所有EXCEL文件?

Posted 2023-05-09

参考技术A 注意 c:\a 目录下的文件不要太多,免得死机

Sub 打开excel表格()
Dim myPath$, myFile$, AK As Workbook
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
myPath = "c:\a\" '把文件路径定义给变量
myFile = Dir(myPath & "*.xls") '依次找寻指定路径中的*.xls文件
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件
End If
myFile = Dir '找寻下一个*.xls文件
Loop
Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
End Sub

在所有工作表中自动打开Excel文件到单元格A1（使用VBA）

我正在尝试编写VBA代码，这样每当我在excel中打开任何文件时，它会自动转到所有工作表中的Cell A1（无论上次保存时选择了哪些单元格）。我在网上发现了一些建议在我的Personal .xlsb项目中添加以下代码：

Sub kTest()

    Dim i As Long, s() As String, a As String, n As Long

    With ActiveWorkbook
        For i = 1 To .Worksheets.Count
            a = a & .Worksheets(i).Name
            n = n + 1
            ReDim Preserve s(1 To n)
            s(n) = .Worksheets(i).Name
            If Len(a) > 224 Then
                .Worksheets(s).Select
                .Worksheets(s(1)).Activate
                [a1].Select
                n = 0: a = "": Erase s
            End If
        Next
        If Len(a) Then
            .Worksheets(s).Select
            .Worksheets(s(1)).Activate
            [a1].Select
        End If
        Application.Goto .Worksheets(1).Range("a1")
    End With

End Sub

但是当我打开文件时没有任何反应。请帮忙！

答案

你不能在每张表中转到Cell A1。但是，如果您想要单张表格的单元格A1，您可以执行以下操作。

使用以下代码创建一个ExcelEvents类

Option Explicit

Private WithEvents App As Application

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    App.Goto Wb.Worksheets(1).Range("A1")
End Sub

Private Sub Class_Initialize()
    Set App = Application
End Sub

并在ThisWorkbook中添加

Option Explicit

Private xlApp As ExcelEvents

Private Sub Workbook_Open()
    Set xlApp = New ExcelEvents
End Sub

保存工作簿，重新打开它，workbook_open事件中的代码将运行，这意味着一旦打开另一个工作簿，代码将转到工作表1的单元格A1

编辑如果您真的想在每张表中选择A1，您可以按如下方式更改代码

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Dim sh As Worksheet
    App.ScreenUpdating = False
    For Each sh In Wb.Worksheets
        sh.Select
        sh.Range("A1").Select
    Next
    App.Goto Wb.Worksheets(1).Range("A1")
    App.ScreenUpdating = True
End Sub

另一答案

简单的解决方案：

    For Each Sheet In ActiveWorkbook.Worksheets
        Sheet.Select
        Range("A1").Select
    Next

另一答案

在工作表中使用MicScoPau循环将以下代码放在Personal.xlsb的ThisWorkbook模块中：您必须重新打开excel才能使其首次运行。如果您的Personal.xlsb被隐藏，那么您将在activeworkbook中的每个工作表中遇到一些问题。

Private WithEvents app As Application

Private Sub app_WorkbookOpen(ByVal Wb As Workbook)
    For Each Sheet In ActiveWorkbook.Worksheets
        Sheet.Select
        Range("A1").Select
    Next
End Sub

Private Sub Workbook_Open()
  Set app = Application
End Sub