打开文件对话框以获取Excel

时间:2015-06-10 23:15:15

标签: excel vba ms-word word-vba

我写了一些Word VBA,它带有一个Excel文件并更新Word文件中的标签(ActiveX控件)。唯一的事情是这个Excel文件每个月都会更改路径和文件名。如何添加“打开文件”对话框,以便用户选择要使用的Excel文件,而不是每月编辑2个变量?

以下是我现在所拥有的:

Sub Update()
    Dim objExcel As New Excel.Application
    Dim exWb As Excel.Workbook

    PathWork = "C:\My Documents\2015-05 Report\"
    CalcFile = "May2015-data.xlsx"

    Set exWb=objExcel.Workbooks.Open(FileName:=PathWork & CalcFile)
    ThisDocument.date.Caption=exWb.Sheets("Data").Cells(1,1)
End Sub

2 个答案:

答案 0 :(得分:2)

这是一个简化的宏,允许用户只选择启用宏的Excel。我无法评论之前的答案,因为我没有赢得足够的声誉来回答评论。请注意。

Public Sub GetCaptionFromExcel()
    Dim objExcel As New Excel.Application, exWb As Workbook
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select Macro-Enabled Excel Files"
        .Filters.Add "Macro-Enabled Excel Files", "*.xlsm", 1
        If .Show <> -1 Then Exit Sub

        Set exWb = objExcel.Workbooks.Open(.SelectedItems(1))
        '*** Use the values from excel here***
        MsgBox exWb.Sheets("Data").Cells(1, 1)
        '*** Close the opened Excel file
        exWb.Close
    End With
End Sub

答案 1 :(得分:0)

你可以试试这样的事情

PathWorkCalcFile替换为Dialogbox

With Dialogs(wdDialogFileOpen)
    If .Display Then
        If .Name <> "" Then
            Set exWb = Workbooks.Open(.Name)
            sPath = exWb.Path
        End If
    Else
        MsgBox "No file selected"
    End If
End With

完成 CODE 应如下所示

Option Explicit

Sub Update()
    Dim objExcel As New Excel.Application
    Dim exWb As Excel.Workbook
    Dim sPath As String

    '// Dialog box here to select excel file
    With Dialogs(wdDialogFileOpen)
        If .Display Then
            If .Name <> "" Then
                Set exWb = Workbooks.Open(.Name)
                sPath = exWb.Path
            End If
            Set exWb = objExcel.Workbooks.Open(FileName:=sPath)
            ActiveDocument.Date.Caption = exWb.Sheets("Data").Cells(1, 1)
        Else
            MsgBox "No file selected"
        End If
    End With
    Set objExcel = Nothing
    Set exWb = Nothing
End Sub