Не работает CorelDraw VBA макрос открытия файла - PullRequest
Новая
       64

Не работает CorelDraw VBA макрос открытия файла

0 голосов
/ 01 февраля 2019

Я использую следующий код для диалога открытия файла, чтобы открыть файл CDR в CorelDraw.Это вызовет диалог, однако я должен использовать 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 голосов
/ 01 февраля 2019

Palmetto Wood Shop!

Прежде всего, я предполагаю, что вы находитесь в какой-то пользовательской форме, в Office (Access или Excel).Я считаю, что вам нужно использовать FileDialog без установки приложения Excel.

Я знаю, что вы установили фильтры для папок .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
...