VBA Excel如何根据部分名称设置工作簿并根据部分名称检查工作簿是否打开

VBA Excel how to set workbook based on partial name and check if work book is open based on partial name

提问by user2980669

Good Afternoon, I never used VBA before so I really need your help! I have following macro (my first ever) and it works fine but after testing with our district managers this file ("SalesOrderRMTOOL.xlsx") open with different name on their computers. How can I change my macro to read only a partial name? It will always be SalesOrderRMTOOL but after it could be anything……?? Thank you for your help in advance

下午好，我以前从未使用过 VBA，所以我真的需要你的帮助！我有以下宏（我有史以来的第一个）并且它工作正常，但在与我们的区域经理测试后，这个文件（“SalesOrderRMTOOL.xlsx”）在他们的计算机上以不同的名称打开。如何更改我的宏以仅读取部分名称？它将永远是 SalesOrderRMTOOL 但之后它可以是任何东西……?? 提前谢谢你的帮助

Private Sub CommandButton1_Click()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim wsTool As Worksheet
    Dim wBook As Workbook
On Error Resume Next
    Set wBook = Workbooks("SalesOrderRMTOOL.xlsx")
    If wBook Is Nothing Then
        MsgBox "Please open SaleOrderRMTOOL file"
        Set wBook = Nothing
        Exit Sub
    End If        
    Set wsSource = Workbooks("SalesOrderRMTOOL.xlsx").Sheets("Salesorder")    
    Set wsTarget = Workbooks("RMORDERTOOL.xlsm").Sheets("Sales Order")        
    Application.ScreenUpdating = False    
    Workbooks("RMORDERTOOL.xlsm").Sheets("Tool").Range("i7:i1003").Value = ""
    Workbooks("RMORDERTOOL.xlsm").Sheets("Tool").Range("l7:l1003").Value = ""
    Workbooks("RMORDERTOOL.xlsm").Sheets("Tool").Range("o7:o1003").Value = ""
    wsTarget.Cells.Clear    
    ' Copy header row to Target sheet if target is empty
    If IsEmpty(wsTarget.Range("A1")) Then wsSource.Rows(1).Copy Destination:=wsTarget.Range("A1")    
        ' Define visible filterd cells on source worksheet and copy
        With wsSource
            .Range("A2", .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column)).SpecialCells(xlCellTypeVisible).Copy
        End With    
        ' Paste to target sheet
        wsTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False

        Application.CutCopyMode = True
        Application.ScreenUpdating = True

        Workbooks("SalesOrderRMTOOL*.xlsx").Close 0

End Sub

回答by Doug Glancy

I would create a short function to return the sales order workbook if it exists. At the top of the module with the function, I'd use a Constant (Const) to hold the beginning of the workbook name, in case it ever changes:

我会创建一个简短的函数来返回销售订单工作簿（如果存在）。在具有该函数的模块的顶部，我将使用一个常量 (Const) 来保存工作簿名称的开头，以防它发生变化：

'Constant at top of module    
Const WORKBOOK_NAME As String = "SalesOrderRMTOOL"

'Anywhere else in same module    
Function GetSalesOrderWb() As Excel.Workbook
Dim wb As Excel.Workbook

For Each wb In Application.Workbooks
    If Left(wb.Name, Len(WORKBOOK_NAME)) = WORKBOOK_NAME Then
        Set GetSalesOrderWb = wb
        Exit Function
    End If
Next
End Function

Then call it like this:

然后像这样调用它：

Set wBook = GetSalesOrderWb
If wBook Is Nothing Then
    MsgBox "Please open SaleOrderRMTOOL file"
    Exit Sub
End If        

回答by Rafael

You can make the person who will use this macro to select the Workbook he will use displaying a dialog like this:

您可以让使用此宏的人选择他将使用的工作簿，显示如下对话框：

Sub BrowseWorkbooks()
Const nPerColumn  As Long = 38          'number of items per column
Const nWidth As Long = 13                'width of each letter
Const nHeight As Long = 18              'height of each row
Const sID As String = "___SheetGoto"    'name of dialog sheet
Const kCaption As String = " Select Workbook"
                                        'dialog caption
Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim cLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton
    Application.ScreenUpdating = False
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
    End If
    On Error Resume Next
        Application.DisplayAlerts = False
        ActiveWorkbook.DialogSheets(sID).Delete
        Application.DisplayAlerts = True
    On Error GoTo 0
    Set CurrentSheet = ActiveSheet
    Set thisDlg = ActiveWorkbook.DialogSheets.Add
    With thisDlg
        .Name = sID
        .Visible = xlSheetHidden
        'sets variables for positioning on dialog
        iBooks = 0
        cCols = 0
        cMaxLetters = 0
        cLeft = 78
        TopPos = 40
        For i = 1 To Workbooks.Count
            If i Mod nPerColumn = 1 Then
                cCols = cCols + 1
                TopPos = 40
                cLeft = cLeft + (cMaxLetters * nWidth)
                cMaxLetters = 0
            End If
            Set CurrentWorkbook = Workbooks(i)
            cLetters = Len(CurrentWorkbook.Name)
            If cLetters > cMaxLetters Then
                cMaxLetters = cLetters
            End If
            iBooks = iBooks + 1
            .OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5
            .OptionButtons(iBooks).Text = _
                Workbooks(iBooks).Name
            TopPos = TopPos + 13
        Next i
        .Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24
        CurrentWorkbook.Activate
        With .DialogFrame
            .Height = Application.Max(68, _
                Application.Min(iBooks, nPerColumn) * nHeight + 10)
            .Width = cLeft + (cMaxLetters * nWidth) + 24
            .Caption = kCaption
        End With
        .Buttons("Button 2").BringToFront
        .Buttons("Button 3").BringToFront
        Application.ScreenUpdating = True
        If .Show Then
            For Each cb In thisDlg.OptionButtons
                If cb.Value = xlOn Then
                    'Store the name of the Woorkbook to use it later
                    SelectedWorkBookName = cb.Caption
                    Exit For
                End If
            Next cb
        Else
            MsgBox "Nothing selected"
        End If
        Application.DisplayAlerts = False
        .Delete
    End With
End Sub

Then use the SelectedWorkBookNamevariable to call the workbook like this:

然后使用SelectedWorkBookName变量调用工作簿，如下所示：

Set wBook = Workbooks(SelectedWorkBookName)