0

我收集了以下 Excel 程序，并将其用于不同工作簿下的几个不同计算。所以我想每次都更改主文件和结果文件的程序，我应该能够选择要在其中进行计算的文件和结果文件的文件路径。

但是我找不到任何可以保存目录的东西，如果您能提供帮助，我将不胜感激

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
4

3 回答 3

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
于 2012-10-23T13:38:56.240 回答
0

以下内容并不是您问题的真正答案，而是一些改进代码的提示，并且由于太长而无法添加为评论。

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在每个模块的顶部使用强制显式声明所有变量，以便更早地发现拼写错误和其他错误。

  • 避免选择单元格

于 2012-10-23T14:24:34.837 回答
0

是的，现在可以浏览文件了；除了所有的来龙去脉，我在命名文件时遇到的问题是由于变量“bi1”并保存了我要求的尽可能多的循环。在打扰您之前，我检查了几次，但我认为我没有足够的信息来解决“fn”作为使用 Application.GetOpenFileName 的文件。

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
于 2012-10-24T05:06:36.000 回答