PowerPoint. Vis dialogboksen "Dias fra filer" via VBA

Kunne dette være en mulighed:

Sub ShowFileDialog()
    Dim dlgOpen As FileDialog
    Set dlgOpen = Application.FileDialog( _
        Type:=msoFileDialogOpen)
       
        With dlgOpen
            .AllowMultiSelect = True
            .Show
        End With
End Sub

Det er ikke den dialogboks - det er "Dias fra filer..."

jeg har fået følgende til at virke, men det virker kun, hvis brugeren ikke har tilføjet nogen præsentationer på fanen "Liste over fortrukne". Hvis brugen har det, så starter dialogboksen nemlig på den fane og mine sendkeys bliver forkerte.

Er der nogen måde hvorved jeg kan tjekke placeringen af kursoren, så jeg kan tage højde for ovenstående?

Det var dether der "virker":

Sub VisDialog()
    Application.CommandBars("Menu bar").Controls("Indsæt").Controls("Dias fra filer...").Execute

    SendKeys ("H:\PowerPoint\Grafer\Grafer.pot")
    SendKeys "{TAB}"
    SendKeys "{TAB}"
    SendKeys "{TAB}"
    SendKeys "{ENTER}"

End Sub

Nu har jeg lavet koden, så jeg kan finde alle kontrolerne på i doailogboksen:

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
'Call back function used by Enum Child Windows

Sub ShowFileNew()
    Application.CommandBars("Menu bar").Controls("Indsæt").Controls("Dias fra filer...").Execute
   
    SendKeys ("H:\PowerPoint\Grafer\Grafer.pot")
    SendKeys ("{TAB}")
    SendKeys ("{TAB}")
    SendKeys ("{TAB}")
    SendKeys ("{ENTER}")
   
    svar = GetText("Diassøgning")
   
End Sub
'Call this function and it will call the EnumChildWindows Function
'You can modify the function to use the ClassName instead of WindowCaption
Public Function GetText(sApplicationName As String)
    'Check if the window exists
    If FindWindow(vbNullString, sApplicationName) <> 0 Then
        'Enumerate the Child Windows
        EnumChildWindows FindWindow(vbNullString, sApplicationName), AddressOf EnumChildProc, ByVal 0&
    End If
End Function
Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
    Dim sReturn As String
    'Get the windowtext length
    sReturn = Space$(GetWindowTextLength(hwnd) + 1)
    'get the window text
    GetWindowText hwnd, sReturn, Len(sReturn)
    'remove the last Chr$(0)
    sReturn = Left$(sReturn, Len(sReturn) - 1)
    If sReturn <> "" Then Debug.Print sReturn
        If sReturn = "Søg efter præsentation" Then
            'placer cursoren på fanen "Søg efter præsentation"
        End If
    'continue enumeration
    EnumChildProc = 1
End Function


men hvordan sætter placerer jeg cursoren på fanen "Søg efter præsentation"?

her er løsningen:

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Dim m_strTabName As String 'Lokal var til at angive tab-navnet

Sub ShowFileNewGraf()
Dim strChosenTab As String

    On Error GoTo Error
'    Application.CommandBars("Menu bar").Controls("Insert").Controls("Slides from Files...").Execute
    Application.CommandBars("Menu bar").Controls("Indsæt").Controls("Dias fra filer...").Execute

    DoEvents
'    strChosenTab = GetText("Slide Finder")
    strChosenTab = GetText("Diassøgning")
   
'    If strChosenTab = "Liste over foretrukne" Then
    If strChosenTab = "&Filer:" Then
        SendKeys ("^{TAB}")
        DoEvents
       
    End If
   
   
    SendKeys ("%F")
    SendKeys ("H:\PowerPoint\Grafer\Grafer.pot")
    SendKeys ("%V") 'Sender Alt + D = Display
   
    GoTo Slut
Error:
    MsgBox Err.Number
Slut:
End Sub
Sub ShowFileNewDiagram()
Dim strChosenTab As String

    On Error GoTo Error
'    Application.CommandBars("Menu bar").Controls("Insert").Controls("Slides from Files...").Execute
    Application.CommandBars("Menu bar").Controls("Indsæt").Controls("Dias fra filer...").Execute

    DoEvents
'    strChosenTab = GetText("Slide Finder")
    strChosenTab = GetText("Diassøgning")
   
'    If strChosenTab = "Liste over foretrukne" Then
    If strChosenTab = "&Filer:" Then
        SendKeys ("^{TAB}")
        DoEvents
       
    End If
   
   
    SendKeys ("%F")
    SendKeys ("H:\PowerPoint\Grafer\Grafer.pot")
    SendKeys ("%V") 'Sender Alt + D = Display
   
    GoTo Slut
Error:
    MsgBox Err.Number
Slut:
End Sub
Public Function GetText(sApplicationName As String) As String


    'Nulstiller tabnavn
    m_strTabName = ""
   
    'Check if the window exists
    If FindWindow(vbNullString, sApplicationName) <> 0 Then
        'Enumerate the Child Windows
        EnumChildWindows FindWindow(vbNullString, sApplicationName), AddressOf EnumChildProc, ByVal 0&
    End If
       
    'Returnerer tabnavn
    GetText = m_strTabName
End Function
Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
    Dim sReturn As String
   
    'Get the windowtext length
    sReturn = Space$(GetWindowTextLength(hwnd) + 1)
    'get the window text
    GetWindowText hwnd, sReturn, Len(sReturn)
    'remove the last Chr$(0)
    sReturn = Left$(sReturn, Len(sReturn) - 1)
    Debug.Print sReturn
    'Debug.Print sReturn
    'Gemmer fanenavnet. Det er det første navn, der findes frem
    If m_strTabName = "" Then m_strTabName = sReturn
   
    'continue enumeration
    EnumChildProc = 1
End Function