Allow a user to insert a picture/logo into a report using a dialog box

[Aubs010]

HI, hope someone can help!!

Basically, in a form, I want to be able to get a user to either type in the location of a logo to use or click on a button that opens a dialog for them to find the logo. They then press OK and it saves the location (on the local system) to a text box.

Then, when they preview a report, THAT same logo is shown somewhere in the report.

I would presume I would need a common dialog thingy, but I've never used it/one so don't have a cloe where to start. I found some other information in a question asked on EE and that said use the code:

Dim oCDLG As Object
Set oCDLG = CreateObject("MSComDlg.CommonDialog&quot
oCDLG.InitDir = "c:\"
oCDLG.showOpen

I put that code in an [Event Procedure] for an on Click event. Pressed the button and Nothing happened!!!

I don't mind if the logo is saved somewhere (embedded?) when they click on the find logo dialog and then later referenced in the report. Either way, I want the user to select which logo goes on the report...

Any suggestions would be greatly appreciated.

Aubs

 

[HHaskel]

If you are using Access 2002 you can check out the Employees-form in the Northwinddatabase.

There is an example how you can select a picture with a filedialog.


/Hakan Haskel

 

[Aubs010]

Right then, that has helped a bit, thank you HHaskel.

I have nearly copied the code:

Private Sub Command38_Click()
Dim fileName As String
Dim result As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select Company Logo"
.Filters.Add "All Files", "*.*"
.Filters.Add "JPEGs", "*.jpg"
.Filters.Add "Bitmaps", "*.bmp"
.FilterIndex = 3
.AllowMultiSelect = False
.InitialFileName = CurrentProject.Path
result = .Show
If (result <> 0) Then
fileName = Trim(.SelectedItems.Item(1))
'Me![Site Logo_Item].Visible = True
Me![Site Logo_Item].SetFocus
Me![Site Logo_Item].Text = fileName
Me![Site Logo_Item].SetFocus
ImgPicture.Picture = [Site Logo]
'Me![Site Logo_Item].Visible = False
End If
End With

End Sub

But now, when I click on the button &quot;Command38&quot; nothing happens! Does this imply that I would need an addin or something?

Site Logo_Item is the textbox name (the control is from [Site Logo] in the table Site Details

Any more help would be greatly appreciated
Aubs

 

[HHaskel]

I don't think you need any extra addins, did the button work in Nortwind?

Maybe if you change the code like this:

If (result <> 0) Then
    fileName = Trim(.SelectedItems.Item(1))
    Me.[Site Logo_Item] = fileName
    Me.ImgPicture = fileName
    Me.ImgPicture.Visible = True
End If

Me.ImgPicture should be a imagebox and Me.[Site Logo_Item] should be a textbox in your form.

/Hakan Haskel

 

[Aubs010]

Thanks for your reply,

Yes, it did work in the Northwind one, I would have thought even if the IF statement wasn't there, it should still pop up a dialog asking you to select a file...but it doesn't :-(


Aubs

 

[jenlion]

I found this yesterday in another forum. Different solution, but it's working great for me.

Put all of this in a module.
-----------------------------------------------------

Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Declare Function aht_apiGetOpenFileName Lib &quot;comdlg32.dll&quot; _
Alias &quot;GetOpenFileNameA&quot; (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib &quot;comdlg32.dll&quot; _
Alias &quot;GetSaveFileNameA&quot; (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib &quot;comdlg32.dll&quot; () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Function TestIt()
Dim strFilter As String
Dim lngFlags As Long
strFilter = ahtAddFilterItem(strFilter, &quot;Access Files (*.mda, *.mdb)&quot;, _
&quot;*.MDA;*.MDB&quot
strFilter = ahtAddFilterItem(strFilter, &quot;dBASE Files (*.dbf)&quot;, &quot;*.DBF&quot
strFilter = ahtAddFilterItem(strFilter, &quot;Text Files (*.txt)&quot;, &quot;*.TXT&quot
strFilter = ahtAddFilterItem(strFilter, &quot;All Files (*.*)&quot;, &quot;*.*&quot
MsgBox &quot;You selected: &quot; & ahtCommonFileOpenSave(InitialDir:=&quot;C:\&quot;, _
Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:=&quot;Hello! Open Me!&quot
' Since you passed in a variable for lngFlags,
' the function places the output flags value in the variable.
Debug.Print Hex(lngFlags)
End Function

Function GetOpenFile(Optional varDirectory As Variant, _
Optional varTitleForDialog As Variant) As Variant
' Here's an example that gets an Access database name.
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
lngFlags = ahtOFN_FILEMUSTEXIST Or _
ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then
varDirectory = &quot;&quot;
End If
If IsMissing(varTitleForDialog) Then
varTitleForDialog = &quot;&quot;
End If

' Define the filter string and allocate space in the &quot;c&quot;
' string Duplicate this line with changes as necessary for
' more file templates.
strFilter = ahtAddFilterItem(strFilter, _
&quot;Access (*.mdb)&quot;, &quot;*.MDB;*.MDA&quot
' Now actually call to get the file name.
varFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:=varTitleForDialog)
If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If
GetOpenFile = varFileName
End Function

Function ahtCommonFileOpenSave( _
Optional ByRef Flags As Variant, _
Optional ByVal InitialDir As Variant, _
Optional ByVal Filter As Variant, _
Optional ByVal FilterIndex As Variant, _
Optional ByVal DefaultExt As Variant, _
Optional ByVal Filename As Variant, _
Optional ByVal DialogTitle As Variant, _
Optional ByVal hwnd As Variant, _
Optional ByVal OpenFile As Variant) As Variant
' This is the entry point you'll use to call the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the ahtOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' hWnd: parent window handle
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
' Give the dialog a caption title.
If IsMissing(InitialDir) Then InitialDir = CurDir
If IsMissing(Filter) Then Filter = &quot;&quot;
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(Flags) Then Flags = 0&
If IsMissing(DefaultExt) Then DefaultExt = &quot;&quot;
If IsMissing(Filename) Then Filename = &quot;&quot;
If IsMissing(DialogTitle) Then DialogTitle = &quot;&quot;
If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
If IsMissing(OpenFile) Then OpenFile = True
' Allocate string space for the returned strings.
strFileName = Left(Filename & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With OFN
.lStructSize = Len(OFN)
.hwndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
' Didn't think most people would want to deal with
' these options.
.hInstance = 0
'.strCustomFilter = &quot;&quot;
'.nMaxCustFilter = 0
.lpfnHook = 0
'New for NT 4.0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
' This will pass the desired data structure to the
' Windows API, which will in turn it uses to display
' the Open/Save As Dialog.
If OpenFile Then
fResult = aht_apiGetOpenFileName(OFN)
Else
fResult = aht_apiGetSaveFileName(OFN)
End If

' The function call filled in the strFileTitle member
' of the structure. You'll have to write special code
' to retrieve that if you're interested.
If fResult Then
' You might care to check the Flags member of the
' structure to get information about the chosen file.
' In this example, if you bothered to pass in a
' value for Flags, we'll fill it in with the outgoing
' Flags value.
If Not IsMissing(Flags) Then Flags = OFN.Flags
ahtCommonFileOpenSave = TrimNull(OFN.strFile)
Else
ahtCommonFileOpenSave = vbNullString
End If
End Function

Function ahtAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like &quot;Databases&quot, a null character, the skeleton
' (like &quot;*.mdb;*.mda&quot and a final null character.

If IsMissing(varItem) Then varItem = &quot;*.*&quot;
ahtAddFilterItem = strFilter & _
strDescription & vbNullChar & _
varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function
-----------------------------------------------

The function TestIt ... tests it. You can modify it for your purposes.

I have another reason for saving the file location, so I actually have a table that temporarily stores the file location string that points to the picture. I display the picture and save the filename in this table:
--------------
Private Sub SetPic()
If RealFN.Text <> &quot;&quot; Then
Dim strip As String
strip = RealFN.Text
Dim x As Integer
For x = 1 To 20
If Right(strip, 1) <> &quot;\&quot; Then 'want to have only the name of the item, following final strip = Left(strip, Len(strip) - 1) 'remove the last characters
End If
Next x

Dim RealName As String
RealName = Right(RealFN.Text, (Len(RealFN.Text) - Len(strip)))

JewelPic.Picture = RealFN.Text
PicName.Caption = RealName
cmdNext.SetFocus
End If
End Sub
----------------
Private Sub cmdOther_Click()
Dim strFilter As String
Dim strInputFileName As String

strFilter = ahtAddFilterItem(strFilter, &quot;JPEG files (*.jpg)&quot;, &quot;*.jpg&quot
strInputFileName = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
Flags:=ahtOFN_HIDEREADONLY, InitialDir:=&quot;z:\graphic\&quot


RealFN.SetFocus
RealFN.Text = strInputFileName

SetPic

End Sub
------------------------
Then in the report detail, I do the easy thing:

JewelPic.Picture = Me.PictureFile

&quot;Me&quot;, of course, is the recordset that includes this file location. May be different for you, if you don't need to save this stuff out, but that's how I'm doing it.

HTH
Jennifer

 

[Aubs010]

OMG! That's a lot just to have a dialog appear to insert a picture!!

I've got it working easilly if I just type an address into a text box, but thought it would look better if I gave the option of looking for the file without having to type it!!

Think I'll leave it as it is for now, but thank you very much for the assistance!

If anyone has an easier way of doing it, I would appreciate it.

Aubs
Aubs

 

[jenlion]

It is a lot, probably too much. Maybe I'm being lazy in not looking for a better way.... Much easier in VB, just include the common dialog, but I didn't find a quick way of doing that in Access. I'll be watching too to see if there's a more elegant solution.

 

[Aubs010]

Well, there is a lot more elegant solution, as found in the Northwind sample database.

Unfortunately, It works fine in the sample, but when I copy the code into my own, noting happens %-(
Aubs