CorelDraw VBA“文件打开”宏不起作用

时间:2019-02-01 16:45:35

标签: vba coreldraw

我正在使用以下代码进行文件打开对话框,以在CorelDraw中打开CDR文件。它将拉起对话,但是,我必须使用Alt + Tab才能看到它。同样,很多时候,它会使应用程序完全冻结。有什么想法吗?

Private Sub cmdCDRFile_Click()
Dim str As String
  Dim objFileDialog As Office.FileDialog
  Dim objFileDialogFilters As Office.FileDialogFilters
  Dim CDRFileOject As Excel.Application
  Set CDRFileOject = New Excel.Application

  Set objFileDialog = CDRFileOject.Application.FileDialog(msoFileDialogType.msoFileDialogFilePicker)
  If CDRInitialFolder = "" Then
      CDRInitialFolder = "C:\Users\<user name here>\Desktop"
  End If
  With objFileDialog

      'define a Filters object
      Set objFileDialogFilters = .Filters
      With objFileDialogFilters

'clear the default filters
         .Clear

'add a filter, all filters must start with an asterisk
         .Add "CDR template Files", "*.CDR"
      End With
      .InitialFileName = CDRInitialFolder

      'allow only one file to be selected
      .AllowMultiSelect = False
      Dim hxl As Long
      hxl = FindWindowA("XLMAIN", "Excel")
      If (hxl <> 0) Then
        res = SetForegroundWindow(hxl)
      End If
      'show the dialog and exit if Cancel is pressed
      If objFileDialog.Show = 0 Then
         Exit Sub
      End If
  End With

  txtCDRFile.Text = objFileDialog.SelectedItems(1)
  CDRFileOject.Quit
  Set CDRFileOject = Nothing
  CDRInitialFolder = Left(txtCDRFile.Text, InStrRev(txtCDRFile.Text, "\"))
End Sub

1 个答案:

答案 0 :(得分:0)

Palmetto木头店!

首先,我猜您在Office(Access或Excel)的某种UserForm中。 我相信您无需设置Excel应用程序就可以使用FileDialog。

我知道您将过滤器设置为.CDR和Initial文件夹,但是请尝试使用此代码(一种简化的代码)来查看性能是否得到改善。

如果您单击以仅接收文件和文件夹名称的字符串,我认为它应该是一个函数。

在CallFunction SUB中,您可以调用并将结果放在“ txtCDRFile.Text”文本框之类的位置

Private Function Selecting_Files()
 Dim f As Object

 Set f = Application.FileDialog(3)
     f.AllowMultiSelect = False
     f.Show

     SelectedFiles = f.SelectedItems.Count

     If SelectedFiles < 1 Then
       MsgBox "None file Selected", vbOKOnly, "Error"
       Exit Function
     End If

     File_Fullname = f.SelectedItems(1)
     File_Folder = Left(File_Fullname, InStrRev(File_Fullname, "\"))
     File_Name = Mid(File_Fullname, InStrRev(File_Fullname, "\") + 1, Len(File_Fullname) - InStrRev(File_Fullname, "\"))

     Selecting_Files = File_Fullname & "§" & File_Folder & "§" & File_Name

End Function

Sub CallFunction()

   FileDetails = Selecting_Files()

   SplitFileDetails = Split(FileDetails, "§")

   File_Fullname = SplitFileDetails(0)
   File_Folder = SplitFileDetails(1)
   File_Name = SplitFileDetails(2)

   MsgBox File_Fullname
   MsgBox File_Folder
   MsgBox File_Name

End Sub