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

はい、ファイルのブラウジングが機能するようになりました。すべての内外はさておき、変数「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
于 2012-10-24T05:06:36.000 に答える
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 に答える