VBA объект не создан? - PullRequest
       5

VBA объект не создан?

0 голосов
/ 09 января 2019

в следующем коде I иногда, не всегда! выдается ошибка в «Set PP = pptApp.Presentations.Open (pptVorlage)». Когда я проверяю значение «pptApp» в ближайшем окне с помощью «? PptApp», VBA не может вернуть значение.

Что это значит? Объект не был создан? Или установить нулевое значение во время кода?

Заранее спасибо!

Public myfilename As String

Sub Saveas_PDF()
    Dim PP As PowerPoint.Presentation
    Dim company As String
    Set DropDown.ws_company = Tabelle2
    company = DropDown.ws_company.Range("C2").Value

    Dim strPOTX As String
    Dim strPfad As String
    Dim pptApp As Object

    Call filepicker

    Dim Cell As Range

    Set pptApp = New PowerPoint.Application

    For Each Cell In DropDown.ws_company.Range(DropDown.ws_company.Cells(5, 3), DropDown.ws_company.Cells(Rows.Count, 3).End(xlUp)).SpecialCells(xlCellTypeVisible)
        Dim pptVorlage As String
        pptVorlage = myfilename

        Set PP = pptApp.Presentations.Open(pptVorlage) 'sometimes error (remote server machine not found.) + pptApp seems to be empty?
        PP.UpdateLinks
        pptApp.Visible = True
        Debug.Print (PP.Name)
        AppActivate (PP.Name)
        PP.Close
        Set PP = Nothing
    Next

    Set pptApp = New PowerPoint.Application
    If IsAppRunning("PowerPoint.Application") Then
        If pptApp.Windows.Count = 0 Then

            pptApp.Quit
        End If
    End If

    Set pptApp = Nothing
End Sub

Sub filepicker()

 Dim i As Variant
 MsgBox ("In the following dialog please choose the current file")
 Dim myfilenamepicker As FileDialog
 Set myfilenamepicker = Application.FileDialog(msoFileDialogFilePicker)
 myfilenamepicker.InitialFileName = "C:\Users\XY"
 myfilenamepicker.Show
 If myfilenamepicker.SelectedItems.Count <> 0 Then
 myfilename = myfilenamepicker.SelectedItems(1)
 End If


End Sub

Function IsAppRunning(ByVal sAppName) As Boolean
    Dim oApp As Object
    On Error Resume Next
    Set oApp = GetObject(, sAppName)
    If Not oApp Is Nothing Then
    Set oApp = Nothing
    IsAppRunning = True
    End If
End Function

1 Ответ

0 голосов
/ 09 января 2019

Я полагаю, что проблема в том, что код в вопросе имеет две одинаковые строки:

Set pptApp = New PowerPoint.Application

Каждая строка заставит VBA запустить новый экземпляр PowerPoint, и он попытается назначить их одной и той же переменной объекта (pptApp). Это является причиной ошибки удаленного сервера.

Закомментируйте вторую строку, которая запускает новый экземпляр PowerPoint, и посмотрите, не работают ли вещи лучше - или, по крайней мере, по-другому.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...