Insert an image file in a MAC Word Userform - vba

I am not a programmer so not sure what to do here. I would like an option of adding an image file in a Microsoft Word document userform for MAC. I had used a code earlier which works perfectly in Windows but it doesnt work for MAC and gives a 5948 error. I had added a field for the image in the userform with a button to add the image and the final submit button. The add button should allow the user to insert any size image from the local folder.
The code I was using is given below:
Dim ImagePath As String
Private Sub CMDAddImage_Click()
Dim objFileDialog As Office.FileDialog
Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = False
.ButtonName = "File Picker"
.Title = "File Picker"
If (.Show > 0) Then
End If
If (.SelectedItems.Count > 0) Then
Call MsgBox(.SelectedItems(1))
ImagePath = .SelectedItems(1)
End If
End With
Image1.Picture = LoadPicture(ImagePath)
End Sub
And the code in submit button was:
Dim objWord
Dim objDoc
Dim objShapes
Dim objSelection
'Set objSelection = ActiveDocument.Sections
'objSelection.TypeText (vbCrLf & "One Picture will be inserted here....")
ActiveDocument.Bookmarks("Field04").Select
Set objShapes = ActiveDocument.InlineShapes
objShapes.AddPicture (ImagePath)
End
End Sub
Can someone please help me edit the code for mac. In mac it does not allow to add the file.

You should check out the suggestion made by #JohnKorchok in a comment to your previous question - insert an image Content Control in your document instead, and throw away the VBA.
But if you need to keep using VBA and a UserForm...
Application.FileDialog is not available on Mac.
Application.GetOpenFileName is not avaialble from Word (it's an Excel thing).
Application.Dialogs does not do the same thing as GetOpenFileName so the user experience will be rather different, but at its simplest, you can use it like this:
With Application.Dialogs(wdDialogFileOpen)
' .Display = -1 for "OK" ("Open" in this case)
' .Display = 0 for "Cancel"
' (THere are other possible return values
' but I do not think they are applicable here)
If .Display = -1 Then
ImagePath = .Name
End If
End With
or if you prefer, the lengthier
Dim dlg As Word.Dialog
Set dlg = Application.Dialogs(wdDialogFileOpen)
With dlg
If .Display = -1 Then
ImagePath = .Name
End If
End With
Set dlg = Nothing
However, this dilaog does not let you specify file types or any kind of filtering, a starting folder etc. Attempts to set Finder search criteria via something like
.Name = "(_kMDItemFileName = ""*.jpg"")"
.Update
before the .Display either can't work or need different syntax.
Further, the Apple dialog may start with its
own filtering set up so the user will have to click Options to enable All Files. You don't know what file type the user will choose so you will need to deal with that.
An alternative is to invoke Applescript. For this, it appears that you can still use the VBA MacScript command, which means that you can put all the script in your VBA file. If that does not work, then unfortunately you have to use AppleScriptTask which would require you to work some more on the Script and install the script in the correct folder on every Mac where you need this feature.
Here's the code I used - you would probably need to wrap everything up in another function call and use conditional compilation or other tests to call the correct routine depending on whether the code is running on Mac or Windows
Private Sub CMDAddImage_Click()
Dim s As String
Dim sFileName As String
On Error Resume Next
s = ""
' set this to some other location as appropriate
s = s & "set thePictureFoldersPath to (path to pictures folder)" & vbNewLine
s = s & "set applescript's text item delimiters to "",""" & vbNewLine
s = s & "set theFile to ¬" & vbNewLine
' add the image file types you want here
s = s & "(choose file of type {""png"",""jpg""} ¬" & vbNewLine
s = s & "with prompt ""Choose an image to insert."" ¬" & vbNewLine
s = s & "default location alias thePictureFoldersPath ¬" & vbNewLine
s = s & "multiple selections allowed false) as string" & vbNewLine
s = s & "set applescript's text item delimiters to """"" & vbNewLine
' choose file gives as an AFS path name (with colon delimiters)
' get one Word 2016/2019 will work with
s = s & "posix path of theFile"
sFileName = MacScript(s)
If sFileName <> "" Then
' Maybe do some more validation here
ImagePath = sFileName
Image1.Picture = LoadPicture(ImagePath)
End If
End Sub

Related

Edit a textbox within header (first page different)

EDIT: I can make it work in a separate document, but not based on the template documents.
I am trying to edit a textbox within the header of a template-created file within a loop. The textbox name is "Text Box 2." It already has text inside of the box. The goal is replace one of the words ("COUNTRYNAME") with the String CountryName2 (see full sub posted below). Here is the relevant code for actually getting in and editing the textbox:
Set tFile = Documents.Add(tPath)
Selection.InsertFile (cDirPath & "\" & cFile)
Debug.Print tFile.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes.Range(Array("Text Box 2")).TextFrame.TextRange.Text 'This will print the text within the textbox with DebugPrint but if I try to set it = to something and get rid of Debug.Print (allegedly to edit/add text) nothing happens
I can edit the text within the Header using a simple: tFile.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text = "Replaced Header Text"
But it replaces the entire header with that text (I have a number of things on the header already that I do not want to change - just the one and only textbox.
Entire sub: The point of the sub is to open a bunch of files within a directory and copy them into a new template document, then change that template header to match a country name found within the filename.
Sub CopyAndPaste()
Dim tPath As String 'template path string
Dim tFile As Document 'template file
Dim cDirPath As String 'copy directory Path
Dim cName As String 'name of copy
Dim CountryName As String ' country name1
Dim CountryName2 As String ' country name2
Dim pDir As String
Dim findTextH As String
findTextH = "COUNTRYNAME"
pDir = "C:\Users\XXX\XXXX\Desktop\Test\Saved\"
With Application.FileDialog(msoFileDialogFilePicker) 'pick the template document path
.ButtonName = "Pick Template"
.Title = "Pick the template"
If .Show <> 0 Then
tPath = .SelectedItems(1)
End If
End With
With Application.FileDialog(msoFileDialogFolderPicker) 'pick the directory with the files path
' show the file picker dialog box
If .Show <> 0 Then
cDirPath = .SelectedItems(1)
End If
End With
cFile = Dir(cDirPath & "\" & "*.docx")
Do While cFile <> ""
cName = GetFilenameFromPath(cFile) 'get the original file name without path
CountryName = Mid(cName, 19)
CountryName2 = Left(CountryName, Len(CountryName) - 5)
Set tFile = Documents.Add(tPath)
Selection.InsertFile (cDirPath & "\" & cFile)
Debug.Print tFile.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text
'.Shapes.Range(Array("Text Box 2")).TextFrame.TextRange.Text = "Testing" ***FOR TESTING&***
tFile.SaveAs2 FileName:=pDir & cName
tFile.Close
cFile = Dir
Loop
End Sub
I solved this issue. This was due to a hidden textbox on the second page header which was messing things up. The textbox was filled with white text!!! Ended up figuring it out somehow.

Closing document after saving it with wdFormatDocument format

I have a longer code and in the final part there is an ActiveX button for saving and closing the file. Also, for efficiency, I've added an vbYesNo command for creating a new document based on the template in use.
The code:
Sub macrosave ()
Dim doc As Document
Dim strDosar As String
Dim Ret As Variant
Set doc = Application.ActiveDocument
strDosar = Range.Paragraphs(1).Range.Text
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then
Documents.Add Template:=ActiveDocument.AttachedTemplate.Path & Application.PathSeparator & ActiveDocument.AttachedTemplate.Name
End If
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument = 0
doc.Close
End Sub
If I click yes, a new document is created, the last one is saved and closed afterwards.
If I click no, the active document is saved, but it is not closed afterwards.
I suspect it has something to do with the file format (wdFormatDocument) because this way it eliminates all VBA codes.
The file format is needed because I want to get rid of all content controls after saving the file.
Why doc.Close is not being executed in the second case and what are my options in order to achieve the purpose?
This argument is invalid:
FileFormat:=wdFormatDocument = 0
Perhaps:
Sub macrosave()
Dim doc As Document, strDosar As String, Ret As Variant
Set doc = ActiveDocument
strDosar = Split(doc.Range.Paragraphs(1).Range.Text, vbCr)(0)
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then Documents.Add Template:=doc.AttachedTemplate.FullName
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument
doc.Close False
End Sub
I believe the problem comes from a disagreement between the file extension - doc and the specified file format wdFormatDocument.
Starting with Word 2007 the default file format (wdFormatDocument) refers to the Word Open XML file format, docx. To save as the doc file format requires using wdFormatDocument97. The reason it may have intermittently worked is because the numerical value of this enumeration is 0.
Try
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument97
Or change the extension to docx
doc.SaveAs "\\server\Public\" & strDosar & ".docx", FileFormat:=wdFormatDocument
However docx will not remove the content controls the next time the document is opened. (The doc format will because content controls were introduced at the same time as the new file format, so they aren't supported in the old format.)
If the additional purpose is " it eliminates all VBA codes" then it would make sense to change the attached template before closing the document to Normal.dotm. This removes the link to the attached template and has the added advantage that the document will "find" its template no matter who opens it, later. (When the attached template is not present it can delay opening by a considerable time under some circumstances.)
doc.AttachedTemplate = NormalTemplate
Note that it will also make things simpler to pick up the file path using the FullName poperty of the template:
Documents.Add Template:=ActiveDocument.AttachedTemplate.FullName

Access 2013, Module Not Generating Fields on Word 2013 Document, but Function Within Main Form Does

I have a simple Access 2013 database that currently has one table, and one form for inputting data. I input data using the form, things like first name, last name, etc. I then have the database calling a function that takes these values, and places them on a word document in specific areas, (similar to mail merge, but mail merge doesn't suit my exact needs.) The function then converts a copy of that word document to a .pdf, and saves it in a location that is pre-defined.
I currently have the function tied to a button that is on the form. Everything works fine now, and I would like to break the soon-to-be large amount of code that will follow into modules; however, this is where I am having the issue. When I place this function in a module, it does not populate all of the form fields on the word document. It only populates one or two fields, not all of them. If I place the code back in a function that is on the main form, it works just fine.
I do not get any errors either way. The .pdf is created and stored exactly where it is supposed to be, but if the button calls the module, it doesn't populate all of the fields. If the button calls the function within the same form, it works like a champ. I will post a shortened version of the code below.
My initial thoughts are that perhaps I am not calling the module correctly, but at this point, I am lost. I have tried passing the values as 'Function Memo(LN, FN, srcFile) As String', labeling individually 'As String', but I can't seem to get it to work.
Function Memo(LN, FN, srcFile)
Dim appword As Object
Dim doc As Object
Dim Path As String
Dim pdfFileName As String
Dim folderName As String
Dim directory As String
Path = srcFile
folderName = LN & ", " & FN
directory = Application.CurrentProject.Path & "\" & folderName
pdfFileName = directory & "\" & folderName & " 2015 Memo" & ".pdf"
If Dir(directory, vbDirectory) = "" Then
MkDir (directory)
Else
End If
On Error Resume Next
Error.Clear
Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = CreateObject("Word.Application")
appword.Visible = False
End If
Set doc = appword.Documents.Open(Path, , True)
With doc
.FormFields("TextFN1").Result = FN
.FormFields("TextMI1").Result = MI
.FormFields("TextLN11").Result = LN
.ExportAsFixedFormat pdfFileName, 17
appword.Visible = False
Set doc = appword.Documents.Close()
appword.Quit SaveChanges:=False
End With
Set doc = Nothing
Set appword = Nothing
End Function
Wow. Silly me. After some additional exploratory surgery on the code, I found my problem. The issue is that a few of my variables did not have unique names. Problem solved.

Match SaveAs2 Dialog File Type To Application.FileDialog

Say you want to have a button that the user can click and save a copy of the current file as a PDF(Documentation):
Application.ActiveDocument.SaveAs2 fileName:="fileName.pdf", FileFormat:=wdFormatPDF
This works fine, the user is presented with a save dialog, selects a location and the file is saved, however a few things are not correct:
The type displayed does not match what was specified in the VBA, how can this be correct? It still saves as type "PDF" without issue, even after showing "DOCX" as the file type in the "Save as Type" drop down. Also the "fileName.pdf" is not placed in the "File Name" box, its as if the dialog box is unaware of the options set in the VBA code(This same issue is also referenced in this post).
UPDATE 1
After taking a second look at my code I now realize that the SaveAs2 Method was not displaying the dialog menu, the correct version of the code(simplified) can be described as:
Dim selected As String: selected = Application.FileDialog(msoFileDialogSaveAs).Show()
Dim filePath As String
If selected <> 0 Then
filePath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
Application.ActiveDocument.SaveAs2 fileName:=Split(filePath, ".")(0), FileFormat:=wdFormatPDF
End If
So then the real question(I guess) is how do you get "Application.FileDialog" to display the proper type you wish to save in under the "Save as type" drop down, and this has already been answered by #PatricK. Thanks everyone for the help, I apologize for the initial confused nature of this question.
I am surprised for SaveAs2 will bring you a prompt to be honest - Only a new document and .Save will bring you that prompt.
If you want to get something similar to that prompt, you use Application.FileDialog with type msoFileDialogSaveAs.
Use this code below (perhaps as an AddIn suits more):
Option Explicit
Sub MySaveAs()
Dim oPrompt As FileDialog, i As Long, sFilename As String
Set oPrompt = Application.FileDialog(msoFileDialogSaveAs)
With oPrompt
' Find the PDF Filter from Default Filters
For i = 1 To .Filters.Count
'Debug.Print i & " | " & .Filters(i).Description & " | " & .Filters(i).Extensions
' Locate the PDF filter
If InStr(1, .Filters(i).Description, "PDF", vbTextCompare) = 1 Then
.FilterIndex = i
Exit For
End If
Next
' Change the title and button text
.Title = "Saving """ & ActiveDocument.Name & """ to PDF format"
.ButtonName = "Save to PDF"
' Default name
.InitialFileName = ActiveDocument.Name
' Show the Prompt and get Filename
If .Show = -1 Then
sFilename = .SelectedItems(1)
Debug.Print "Final filename: " & sFilename
' Save the file as PDF
ActiveDocument.SaveAs2 sFilename, wdFormatPDF
End If
End With
Set oPrompt = Nothing
End Sub
Screenshot sample:

VBA MS Access 2007 hyperlink insert button

I have a button which inserts a hyperlink into a new record. The field's IsHyperlink property is set to "yes", so I get the hand, but clicking on the inserted path does not go anywhere. I believe the button is updating the record with the path of the file as "text to display" rather than "address."
Private Sub MSDS_btn_Click()
Dim fd As Office.FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Use a With...End With block to reference the FileDialog object.
With fd
'Set the initial path to the D:\Documents\ folder.
.InitialFileName = "D:\Documents\"
.Title = "Select MSDS"
'Use the Show method to display the File Picker dialog box and return the user's action.
'If the user presses the action button...
If .Show = -1 Then
DoCmd.GoToRecord , "", acNewRec
Me![Link MSDS] = .SelectedItems(1)
**
'If the user presses Cancel...
Else
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing
End Sub
I know that putting the following code in at the ** works in Excel, I am after something like it which will work in Access!
ActiveSheet.Hyperlinks.Add Anchor:=Cells(ActiveCell.row, Range("LinkCol").Column), Address:=.SelectedItems(1), TextToDisplay:="MSDS"
Try this if you want the file path as both the hyperlink address and display text.
Me![Link MSDS] = "#" & .SelectedItems(1) & "#"
If you want the address with only the file name (without the path) as the display text, try this:
Me![Link MSDS] = Dir(.SelectedItems(1)) & "#" & .SelectedItems(1) & "#"
See HyperlinkPart Method for more background information. You might even prefer to manipulate your hyperlink field data using HyperlinkPart.