Question

我收集了以下Excel程序，我正在使用它在不同的工作簿下进行几次不同的计算。所以我想改为每次更改main和results文件的过程，我应该能够选择我想要进行计算的文件和结果文件的文件路径。

但我找不到保存目录的任何内容，如果你能提供帮助我感激不尽

Sub AsBuiltForm()

Dim SaveName As String
Dim mainBook As Workbook

a = InputBox("ENTER FIRST NUMBER ")
b = InputBox("ENTER LAST NUMBER ")

Workbooks.Open Filename:="C:\"  'main file can be browsed? 

Set mainBook = Excel.Workbooks("CP.xlsx")

    For i = a - 1 To b - 1

        mainBook.Sheets(1).Range("bi1") = i + 1
        SaveName = Sheets(1).Range("bi1").value & ".xlsx"

        mainBook.SaveCopyAs "C:\" & SaveName 'save directory?
        Workbooks.Open Filename:="C:\" & SaveName 'save directory?

        With Excel.ActiveWorkbook
            .Sheets("1 of 2").Range("A1:CT103").value = Sheets("1 of 2").Range("A1:CT103").value
            .Sheets("2 of 2").Range("A1:CT103").value = Sheets("2 of 2").Range("A1:CT103").value
            Excel.Application.DisplayAlerts = False
            .Sheets("Sheet1").Delete
            .Sheets("il oufall").Delete

            .Sheets("1 of 2").Select
            Columns("Bh:BZ").Select
            Selection.Delete Shift:=xlToLeft

            .Sheets("2 of 2").Select
            Columns("Bn:BZ").Select
            Selection.Delete Shift:=xlToLeft

            .Close True

        End With

    Next

mainBook.Close False
Set mainBook = Nothing

End Sub

Answer 1

您可以使用Application.GetOpenFileName选择要在运行时打开的文件。

您可以使用以下功能浏览要保存文件的文件夹。

Sub FindFolder()

Dim myFolder as String
myFolder = BrowseFolder("Pick a Folder Where to Save")

End Sub

Function BrowseFolder(Optional Caption As String, Optional InitialFolder As String) As String

' based on Browse For Folder from:
' http://www.cpearson.com/excel/BrowseFolder.aspx
' this functions requires that the following Reference is active:
    'Microsoft Shell Controls and Automation

Const BIF_RETURNONLYFSDIRS As Long = &H1

Dim wsh As Object
Dim SH As Shell32.Shell
Dim F As Shell32.Folder

Set wsh = CreateObject("Wscript.Shell")
Set SH = New Shell32.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
If Not F Is Nothing Then
    If F = "Desktop" Then
        BrowseFolder = wsh.Specialfolders(F)
    Else
        BrowseFolder = F.Items.Item.path
    End If
End If

End Function

Answer 2

以下内容并不是您问题的答案，而是一些改进代码的提示，以及添加评论的时间太长。

Workbooks.Open会返回一个Workbook对象，您可以保存参考，因此您不必依赖ActiveWorkbook：

Dim oWorkbook As Workbook

Set oWorkbook = Workbooks.Open(Filename:="C:\" & SaveName)

'***** Do something with oWorkbook
Debug.Print oWorkbook.FullName

Set oWorkbook = Nothing

其他一些提示：

使用每个模块顶部的Option Explicit强制显式声明所有变量，以便更早发现拼写错误和其他错误。
Avoid selecting cells

Answer 3

是的，浏览文件现在有效;抛开所有的细节，我面临的问题是由于变量“bi1”命名文件并保存了我所要求的循环次数。我在打扰你之前检查了好几次，但我认为我没有足够的信息在使用Application.GetOpenFileName时将“fn”作为文件来解决。

Option Explicit

Sub AsBuiltForm()

    Dim fn
    Dim myFolder As String
    Dim SaveName As String, a As Integer, b As Integer, i As Integer      

    myFolder = BrowseFolder("Pick a Folder Where to Save")

    MsgBox "Choose Calculation File "
     fn = Application.GetOpenFilename

Workbooks.Open fn                

    a = InputBox("ENTER FIRST NUMBER ")
    b = InputBox("ENTER LAST NUMBER ")        

For i = a - 1 To b - 1 Step 1

Application.DisplayAlerts = False

Workbooks.Open Filename:=fn

    Range("bi1") = i + 1

    SaveName = ActiveWorkbook.Sheets(1).Range("bi1").value

    Sheets(1).Range("A1:CT103").value = Sheets(1).Range("A1:CT103").value

    Sheets(2).Range("A1:CT103").value = Sheets(2).Range("A1:CT103").value

    Application.ActiveWorkbook.SaveAs myFolder & SaveName


    ActiveWorkbook.Close True

    Next

End Sub  

Function BrowseFolder(Optional Caption As String, Optional InitialFolder As String) As String

' based on Browse For Folder from:
' http://www.cpearson.com/excel/BrowseFolder.aspx
' this functions requires that the following Reference is active:
    'Microsoft Shell Controls and Automation

Const BIF_RETURNONLYFSDIRS As Long = &H1

Dim wsh As Object
Dim SH As Shell32.Shell
Dim F As Shell32.Folder

Set wsh = CreateObject("Wscript.Shell")
Set SH = New Shell32.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
If Not F Is Nothing Then
    If F = "Desktop" Then
        BrowseFolder = wsh.Specialfolders(F)
    Else
        BrowseFolder = F.Items.Item.Path
    End If
End If    
End Function

使用Excel VBA浏览主Excel文件和另存为目录路径

3 个答案: