在主工作簿保持活动状态时打开另一个工作簿

时间:2017-05-19 09:08:02

标签: excel-vba excel-2013 vba excel

我有一个工作簿,其中包含指向另一个工作簿的链接。当我使用链接打开工作簿时,我希望它自动打开链接引用的工作簿,同时具有链接的工作簿始终可见。我已尝试将ScreenUpdating设置为False,但当然这没有任何效果,因为它只会影响活动工作簿中的事件。请注意,链接所指的工作簿需要可访问。这可能吗?

根据某些消息来源,将ScreenUpdating设置为False应该可以解决问题,但以下代码在切换回之前仍会显示工作簿一段时间:

Private Sub Auto_Open()
  Application.ScreenUpdating = False
  Workbooks.Open Filename:=Path
  Application.ScreenUpdating = True
  ThisWorkbook.Activate
End Sub

这是我的完整代码:

Private Sub Auto_Open()
  Dim sType As String
  Dim sFNType As String
  Dim sONFormat As String
  Dim objFSO As Object
  Dim objFolder As Object
  Dim objSubFolder As Object
  Dim sLastSubFolder As String
  Dim sDay As String
  Dim sMonth As String
  Dim iMonth As Integer
  Dim sYear As String
  Dim sOrderNo As String
  Dim iOrderNo As Integer
  Dim sPath As String
  Dim sFilename As String
  Dim tfOrderNo As String
  Dim iResult As Integer

  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
  End With
  If ActiveWorkbook.Name = Name Then
    frmOrderType.Show vbModal
    If Not iType = 4 Then
      Select Case iType
        Case 0
          sType = "Standard Orders"
          sFNType = "K"
          sONFormat = "0000"
        Case 1
          sType = "Promotion Orders"
          sFNType = "KP"
          sONFormat = "000"
        Case 2
          sType = "Test Orders"
          sFNType = "KT"
          sONFormat = "000"
      End Select
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objFolder = objFSO.GetFolder(Path & sType)
      Do Until objFolder.SubFolders.Count = 0
        For Each objSubFolder In objFolder.SubFolders
          sLastSubFolder = objSubFolder.Name
        Next objSubFolder
        Set objFolder = objFSO.GetFolder(objFolder.Path & "\" & sLastSubFolder)
      Loop
      iOrderNo = Val(Replace(Mid(sLastSubFolder, 7, 5), sFNType, "")) + 1
      sOrderNo = "SJ-" & sFNType & Format(iOrderNo, sONFormat)
      iResult = MsgBox("Create order with order number " & sOrderNo & "?", vbOKCancel, "Create Order")
      If iResult = vbOK Then
        tfOrderNo = ActiveWorkbook.Path & "\OrderNo.txt"
        Open tfOrderNo For Output As #1
        Print #1, sOrderNo
        Close #1
      End If
      If Not iResult = 4 Then
        ActiveWorkbook.Save
        sDay = Format(Date, "dd")
        sMonth = Format(Date, "mm")
        sYear = Year(Date)
        If iType = 0 Then
          sPath = Path & sType & "\Orders " & sYear & "\Orders " & sYear & "-" & sMonth & "\KO " & sOrderNo & " " & sDay & sMonth & Format(Date, "yy")
        Else
          sPath = Path & sType & "\KO " & sOrderNo & " " & sDay & sMonth & Format(Date, "yy")
        End If
        MkDirFull sPath
        sFilename = "KO_" & sOrderNo & "_" & sDay & sMonth & Format(Date, "yy")
        ActiveWorkbook.SaveAs Filename:=sPath & "\" & sFilename & ".xlsm"
        Cells(11, 1).Value = "Order No: " & sOrderNo
        Cells(11, 7).Value = Date
        ActiveSheet.Shapes("btnFinalise").Visible = True
        ActiveWorkbook.Save
      End If
    End If
  End If
  Workbooks.Open Filename:=Path 'Open second workbook'
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
  End With
  ThisWorkbook.Activate
End Sub

0 个答案:

没有答案