1

我目前将数据表导入到我从 CAD 导出的 excel 中。这包括摘要、计数和其他数据。我想添加到代码中，以便它将从预定目录导入文件C:\Jobs\packlist并使用单元格内的数字='PL CALC'!B1（这将确定文件名）。这个想法是删除打开的对话框并增加自动化。

这是我迄今为止发现的有效方法。它打开一个选定的文件并将其复制到第 18 页之后的工作簿中。

'import excel data sheet

Sub import()

Dim fName As String, wb As Workbook

'where to look for the framecad excel file

ChDrive "C:"
ChDir "C:\Jobs\packlist"

fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)
    For Each sh In wb.Sheets
            Sheets.Copy After:=ThisWorkbook.Sheets(18)
            Exit For
            Next
    wb.Close False      
    Worksheets("PL CALC").Activate

End Sub
4

1 回答 1

0

导入表格

Option Explicit

Sub ImportSheets()
    Const ProcTitle As String = "Import Sheets"

    Const sFolderPath As String = "C:\Jobs\packlist\"
    Const sfnAddress As String = "B1"
    Const sFileExtensionPattern As String = ".xls*"
    
    Const dwsName As String = "PL CALC"
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dwsName)
    
    Dim sFilePattern As String: sFilePattern = sFolderPath & "*" _
        & dws.Range(sfnAddress).Value & sFileExtensionPattern
    
    Dim sFileName As String: sFileName = Dir(sFilePattern)
    If Len(sFileName) = 0 Then
        MsgBox "No file found..." & vbLf & "'" & sFilePattern & "'", _
            vbCritical, ProcTitle
        Exit Sub
    End If

    Application.ScreenUpdating = False
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sFolderPath & sFileName)
        
    Dim sh As Object
        
    For Each sh In swb.Sheets
        sh.Copy After:=dwb.Sheets(dwb.Sheets.Count)
    Next sh
    
    swb.Close SaveChanges:=False
    
    dws.Activate
    'dwb.Save
    
    Application.ScreenUpdating = True
    
    MsgBox "Sheets imported.", vbInformation, ProcTitle
    
End Sub
于 2021-11-23T12:17:58.277 回答