Import picture file ActiveX

[erez]

I need to add pictures to a certain slide. However the pictures file location , may change so I can't just write hard copy for the pictures location.
Is there an ActiveX I can add to a form, that will enable the user to choose the file location?
I know such an ActiveX exists in vb6, but what about v.b.a, and more specifically in power-point , thought I assume such ActiveX is generic for all office applications

Thanks in advance

[Cosmo]

Here are the functions I am using now (I found them elsewhere online, I don't recall where)
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXPLORER = &H80000
'UDT that makes calling the commondialog easier
Public Type CMDialog
Ownerform As Long
Filter As String
Filetitle As String
FilterIndex As Long
fileName As String
DefaultExtension As String
OverwritePrompt As Boolean
AllowMultiSelect As Boolean
Initdir As String
Dialogtitle As String
Flags As Long
End Type
Public cmndlg As CMDialog
'General Declarations
Private OpenDir As String
Private SaveDir As String
Public Function ShowOpen(Optional Dialogtitle As String = "Open a PowerPoint File:", Optional initialDirectory As String = "C:\") As String
Dim OFName As OPENFILENAME
Dim temp As String
With cmndlg
OFName.lStructSize = Len(OFName)
OFName.hwndOwner = .Ownerform
OFName.hInstance = OFName.hInstance 'App.hInstance
OFName.lpstrFilter = Replace(.Filter, "|", Chr(0))
OFName.lpstrFile = Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = .Initdir
OFName.lpstrTitle = .Dialogtitle
OFName.nFilterIndex = .FilterIndex
OFName.Flags = .Flags Or OFN_EXPLORER Or IIf(.AllowMultiSelect, OFN_ALLOWMULTISELECT, 0)
If GetOpenFileName(OFName) Then
.FilterIndex = OFName.nFilterIndex
If .AllowMultiSelect Then
temp = Replace(Trim$(OFName.lpstrFile), Chr(0), ";")
If Right(temp, 2) = ";;" Then temp = Left(temp, Len(temp) - 2)
.fileName = temp
Else
.fileName = StripTerminator(Trim$(OFName.lpstrFile))
.Filetitle = StripTerminator(Trim$(OFName.lpstrFileTitle))
End If
Else
.fileName = ""
End If
' Need to set return value to .fileName
ShowOpen = .fileName
End With
End Function
Public Function ShowSave(Optional Dialogtitle As String = "Open a PowerPoint File:", Optional initialDirectory As String = "C:\", Optional ByVal fileName As String) As String
Dim OFName As OPENFILENAME
With cmndlg
OFName.lStructSize = Len(OFName)
OFName.hwndOwner = .Ownerform
OFName.hInstance = OFName.hInstance 'App.hInstance
OFName.lpstrFilter = Replace(.Filter, "|", Chr(0))
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = .Initdir
OFName.lpstrTitle = .Dialogtitle
OFName.nFilterIndex = .FilterIndex
OFName.lpstrDefExt = .DefaultExtension
OFName.lpstrFile = .fileName & Space$(254 - Len(.fileName))
OFName.Flags = .Flags Or IIf(.OverwritePrompt, OFN_OVERWRITEPROMPT, 0)

' Is there a way to prevent user from entering '\' in save dialog??
If GetSaveFileName(OFName) Then
.fileName = StripTerminator(Trim$(OFName.lpstrFile))
.Filetitle = StripTerminator(Trim$(OFName.lpstrFileTitle))
' Need to validate name of file (here it's .Filetitle)
' Note - substitute any '\' characters in filename, then rebuild filepath with directory
.FilterIndex = OFName.nFilterIndex
Else
.fileName = ""
End If
' Need to set return value to .fileName
ShowSave = .fileName
End With
End Function
Public Function StripTerminator(ByVal strString As String) As String
'Removes chr(0)'s from the end of a string
'API tends to do this
Dim intZeroPos As Integer
intZeroPos = InStr(strString, Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString, intZeroPos - 1)
Else
StripTerminator = strString
End If
End Function

'// Example usage
Private Function testSaveDialog()
Dim newFilePath As String
With cmndlg
.AllowMultiSelect = False
.DefaultExtension = ".ppt"
.Dialogtitle = "Save a PowerPoint as:"

'.Filter = "All files (*.*)|*.*"
.Filter = "PowerPoint File|*.ppt|PowerPoint Show|*.pps"
.Flags = 5
.Initdir = Application.ActivePresentation.Path
.Ownerform = GetActiveWindow 'HWND
'// prefill the dialog box with the files' name
.fileName = "Im_a_file.txt"
.OverwritePrompt = False ' True
newFilePath = ShowSave
If Len(.fileName) = 0 Then Exit Function
'// save file code
Debug.Print newFilePath
' Dim strFile As String
' strFile = .fileName
'
' Open strFile For Output As #1
' Print #1, "Example......"
' Close #1
End With
End Function
Private Function testOpenDialog()
Dim newFilePath As String
With cmndlg
.AllowMultiSelect = False
.DefaultExtension = ".ppt"
.Dialogtitle = "Open:"

'.Filter = "All files (*.*)|*.*"
.Filter = "PowerPoint File|*.ppt|PowerPoint Show|*.pps"
.Flags = 5
.Initdir = Application.ActivePresentation.Path
.Ownerform = GetActiveWindow 'HWND
'// prefill the dialog box with the files' name
'.fileName = "Im_a_file.txt"
.OverwritePrompt = False ' True
newFilePath = ShowOpen
If Len(.fileName) = 0 Then Exit Function
'// save file code
Debug.Print newFilePath
' Dim strFile As String
' strFile = .fileName
'
' Open strFile For Output As #1
' Print #1, "Example......"
' Close #1
End With
End Function


The last two functions (testOpenDialog and testSaveDialog) show you how to call the 'Save' and 'Open' dialog functions. You will need to change the parameters (such as .Filter ) when you use them (I am using them to select a PowerPoint file)