I need to print a document and have the application hidden. I am using Microsoft Word 2010.
I have tried to hide the application with the code shown below in the Yellow Comments.
objWord.Visible = False
&
objDoc.ActiveWindow.Visible = False
but the window still appear at this line:
objDoc = objWord.Documents.Open("T:\Helsingborg\A\Transport\2. Transportdrift\11. M-trp\Fraktsedlar\Växjö\Växjö Mall.doc")
And becomes hidden as soon as it gets to:
objDoc.ActiveWindow.Visible = False
I really can't find any way to solve this, since I can't use ActiveWindow.Visible = False before the document is opened.
This is my current code.
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
' Step 1
Dim objWord
objWord = CreateObject("Word.Application")
' Hidden window!
objWord.Visible = False
' Save the original printer, otherwise you will reset the system default!
Dim previousPrinter
previousPrinter = objWord.ActivePrinter
objWord.ActivePrinter = ""
' Step 2
Dim objDoc
objDoc = objWord.Documents.Open("T:\Helsingborg\A\....\Växjö Mall.doc")
objDoc.ActiveWindow.Visible = False
' Step 3 -- in this case, print out the document without any prompts
objDoc.PrintOut
' Restore the original printer
objWord.ActivePrinter = previousPrinter
' Step 4
objDoc.Close
' Step 5
objWord.Quit
MsgBox("Everything is now printed") ' Change to custom MSGBOX
End Sub
EDIT: An alternative would be if I can print the word document without opening Word.
set objDoc = GetObject(Filename)
set objWord = objDoc.Parent
in place of the Documents.Open statement
objDoc.Close False
Related
I am a beginner in this matter, could you help me, please?
In PowerPoint, I made code linked to a CommandButton that opens a workbook, when I click on it, Excel opens, but it is flashing on the taskbar and the PowerPoint Presentation remains open. It is possible when clicking on the button Excel opens in front of the Presentation?
Private Sub cmbFAUUSP_Click()
Dim ExcApp As Excel.Application
Set ExcApp = New Excel.Application
ExcApp.Visible = True
ExcApp.Workbooks.Open ("C:\Users\Monster PC\Desktop\tabeladedisciplinas FAUUSP.xlsx")
Set pastatrabalho = ExcApp.ActiveWorkbook
pastatrabalho.Application.ActiveWindow.WindowState = xlMaximized
pastatrabalho.Application.DisplayFullScreen = True
End Sub
If you have not, you should declare all your variables. (Use Option Explicit at the top of the module to help you with that, it will warn you if you forgot to declare a variable)
You don't need to set workbook for what you described so I have commented pastatrabalho, uncomment/remove as you need:
Private Sub cmbFAUUSP_Click()
Dim ExcApp As Excel.Application
Dim pastatrabalho As Excel.Workbook 'Uncomment / Remove as needed
On Error Resume Next
Set ExcApp = GetObject(, "Excel.Application") 'This will retrieve the existing instance of Excel if you already have an Excel running
On Error GoTo -1
If ExcApp Is Nothing Then Set ExcApp = New Excel.Application 'Create a new instance of Excel if not
ExcApp.Workbooks.Open ("C:\Users\Monster PC\Desktop\tabeladedisciplinas FAUUSP.xlsx")
'Replace above line with below if you need to refer to the workbook in the later part of your procedure, if any
'Set pastatrabalho = ExcApp.Workbooks.Open ("C:\Users\Monster PC\Desktop\tabeladedisciplinas FAUUSP.xlsx")
With ExcApp
'Setting Left and Top will brings Excel window to the same location as your Powerpoint (applicable if using multiple monitors)
.Left = Application.Left
.Top = Application.Top
.Visible = True
.WindowState = xlMaximized
.DisplayFullScreen = True
.ActiveWindow.Activate
'AppActivate ExcApp.Caption 'another way of activating, must provide the exact same title as the one shown on your Application (which can differ based on version)
End With
End Sub
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 doesn't 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
How can I edit the code for Mac? In Mac it does not allow to add the file.
I Have been using a VBA code to individually save all letters separately from a mail merge into a designated folder. It has always worked previously howver with the document I am trying to do it for now it is onyl saving the first document and then coming up with an error stating:
run-time error '5825' object has been deleted
When I go to debug it highlights the line near the bottom reading 'DocResult.Close False'
How can I fix this?
Tried changing this to True or deleting line entirely but does not fix problem. Each document is quite large so takes approx 30 seconds to save
Dim WithEvents wdapp As Application
Dim bCustomProcessing As Boolean
Private Sub Document_Open()
Set wdapp = Application
bCustomProcessing = False
ThisDocument.MailMerge.DataSource.ActiveRecord = 1
ThisDocument.MailMerge.ShowWizard 1
With ActiveDocument.MailMerge
If .MainDocumentType = wdFormLetters Then
.ShowSendToCustom = "Custom Letter Processing"
End If
End With
End Sub
Private Sub wdapp_MailMergeWizardSendToCustom(ByVal Doc As Document)
bCustomProcessing = True
Doc.MailMerge.Destination = wdSendToNewDocument
With Doc.MailMerge
For rec = 1 To .DataSource.RecordCount
.DataSource.ActiveRecord = rec
.DataSource.FirstRecord = rec
.DataSource.LastRecord = rec
.Execute
Next
End With
MsgBox "Merge Finished"
End Sub
Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)
If bCustomProcessing = True Then
With Doc.MailMerge.DataSource.DataFields
sFirmFileName = .Item(44).Value ' First Column of the data - CHANGE
End With
DocResult.SaveAs "xxx\" & sFirmFileName & ".doc", wdFormatDocument
' Path and File Name to save. can use other formats like wdFormatPDF too
DocResult.Close False
End If
End Sub
You have to set your object as nothing like this :
Set DocResult = nothing
I'm trying to access from Outlook VBA, either a variable or content control ID that I've created in a word Macro.
Basically I am trying to get set a text field equal to a string variable and load this variable to a message box in outlook.
From outlook, I have the code that creates a word object, and opens the active document, but I'm confused as to accessing the variables. I've tried making the variable in word VBA a public variable with no luck.
Current code to access the variable from outlook:
Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open("C:\Owner\Desktop\Job.docx")
oWordApp.Visible = True
MsgBox(oWordApp.testtest)
Having a look at the ContentControl help file you can pull back the text from the content control using its Tag property.
Sub Test()
Dim oWordApp As Object
Dim oWordDoc As Object
Dim oContent As Variant
Dim oCC As Variant
Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open("S:\DB_Development_DBC\Test\MyNewDoc.docm")
oWordApp.Visible = True
Set oContent = oWordDoc.SelectContentControlsByTag("MyCalendarTag")
If oContent.Count <> 0 Then
For Each oCC In oContent
MsgBox oCC.PlaceholderText & vbCr & oCC.Range.Text
Next oCC
End If
End Sub
The code above displayed Click here to enter a date. as the PlaceHolderText value and 01/01/2007 as the Range.Text value. So no need to add separate functions; just reference the content control directly.
https://msdn.microsoft.com/en-us/library/office/gg605189(v=office.14).aspx
https://msdn.microsoft.com/en-us/vba/word-vba/articles/working-with-content-controls
Edit
As an example of returning value from multiple controls in one function:
Public Sub Example()
Dim MySevenTags As Variant
Dim x As Long
MySevenTags = Array("Tag1", "Tag2", "Tag3", "Tag4", "Tag5", "Tag6", "Tag7")
For x = LBound(MySevenTags) To UBound(MySevenTags)
MsgBox ReturnFromWordContent(CStr(MySevenTags(x))), vbOKOnly
Next x
End Sub
Public Function ReturnFromWordContent(TagID As String) As Variant
Dim oWordApp As Object
Dim oWordDoc As Object
Dim oContent As Variant
Dim oCC As Variant
Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open("S:\DB_Development_DBC\Test\MyNewDoc.docm")
oWordApp.Visible = True
Set oContent = oWordDoc.SelectContentControlsByTag(TagID)
'I've made this next bit up.
'No idea how to get the type of control, or how to return the values.
Select Case oContent.Type
Case "calendar"
ReturnFromWordContent = oContent.Range.Date
Case "textbox"
ReturnFromWordContent = oContent.Range.Text
Case Else
'Return some default value such as Null which
'won't work in this case as it's returning to a messagebox
'but you get the picture.
End Select
' If oContent.Count <> 0 Then
' For Each oCC In oContent
' MsgBox oCC.PlaceholderText & vbCr & oCC.Range.Text
' Next oCC
' End If
End Function
"I've tried making the variable in word VBA a public variable with no luck."
Declare your macro "testtest" as a function with the return value of your variable.
Public Function testtest() As String
dim myVariabel as String
myVariable = "test"
' return value
testtest = myVariable
End Function
Best regards
I have a bunch of mail merge templates setup, when I merge the documents I want to split the results into separate files each one with a name based on the merge field “FileNumber”.
The code I have currently is:
Sub splitter()
' Based on a macro by Doug Robbins to save each letter created by a mailmerge as a separate file.
' With help from http://www.productivitytalk.com/forums/topic/3927-visual-basic-question-for-merge-fields/
Dim i As Integer
Dim Source As Document
Dim Target As Document
Dim Letter As Range
Dim oField As Field
Dim FileNum As String
Set Source = ActiveDocument
For i = 1 To Source.Sections.Count
Set Letter = Source.Sections(i).Range
Letter.End = Letter.End - 1
For Each oField In Letter.Fields
If oField.Type = wdFieldMergeField Then
If InStr(oField.Code.Text, "FileNumber") > 0 Then
'get the result and store it the FileNum variable
FileNum = oField.Result
End If
End If
Next oField
Set Target = Documents.Add
Target.Range = Letter
Target.SaveAs FileName:="C:\Temp\Letter" & FileNum
Target.Close
Next i
End Sub
The problem is if I “Merge to new document” then the “FileNumber” field no longer exists so it can’t pick that up but if I just go to “Preview Results” and run the macro it only saves the currently previewed record and not the rest of the letters.
I’m assuming I need to change the code to something like
For i = 1 To Source.MergedRecord.Count
Set Letter = Source.MergedRecord(i).Range
but I can't work out the correct syntax.
I am aware of http://www.gmayor.com/individual_merge_letters.htm but I don't want the dialog boxes I just want a one click button.
In the Mail merge template document, paste the following macro code in "ThisDocument" module:
Dim WithEvents wdapp As Application
Dim bCustomProcessing As Boolean
Private Sub Document_Open()
Set wdapp = Application
bCustomProcessing = False
ThisDocument.MailMerge.DataSource.ActiveRecord = 1
ThisDocument.MailMerge.ShowWizard 1
With ActiveDocument.MailMerge
If .MainDocumentType = wdFormLetters Then
.ShowSendToCustom = "Custom Letter Processing"
End If
End With
End Sub
Private Sub wdapp_MailMergeWizardSendToCustom(ByVal Doc As Document)
bCustomProcessing = True
Doc.MailMerge.Destination = wdSendToNewDocument
With Doc.MailMerge
For rec = 1 To .DataSource.RecordCount
.DataSource.ActiveRecord = rec
.DataSource.FirstRecord = rec
.DataSource.LastRecord = rec
.Execute
Next
End With
MsgBox "Merge Finished"
End Sub
Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)
If bCustomProcessing = True Then
With Doc.MailMerge.DataSource.DataFields
sFirmFileName = .Item(1).Value ' First Column of the data - CHANGE
End With
DocResult.SaveAs "c:\path\" & sFirmFileName & ".docx", wdFormatXMLDocument
' Path and File Name to save. can use other formats like wdFormatPDF too
DocResult.Close False
End If
End Sub
Remember to update the column number to use for file names, and the path to save the generated files.
After writing this code, save and close the merge template doc. Re-open the file and this time you will be prompted with the Merge wizard. Proceed as required for the Letter, and at the last step, select "Custom Letter Processing" option instead of finishing merge. This will save the separate merged docs in specified folder.
Please remember that this code can be heavy on the processor.
There is a simple solution not involving splitting the resulting document:
Prepare the merge and staying in the template document.Record a macro as you merge one record, then save and close the resulting file, eventuallye advance to the next record.
See the generated macro below. I have added very little code just to extract the filename from a field in the datasource (which is accessible in the template document).
Assign the macro to a shortcut key or implement a loop in VBA. Observe that the fieldnames are casesensitive.
Regards,
Søren
Sub flet1()
'
' flet1 Makro
' 1) Merges active record and saves the resulting document named by the datafield FileName"
' 2) Closes the resulting document, and (assuming that we return to the template)
' 3) advances to the next record in the datasource
'
'Søren Francis 6/7-2013
Dim DokName As String 'ADDED CODE
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
.LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
' Remember the wanted documentname
DokName = .DataFields("FileName").Value ' ADDED CODE
End With
' Merge the active record
.Execute Pause:=False
End With
' Save then resulting document. NOTICE MODIFIED filename
ActiveDocument.SaveAs2 FileName:="C:\Temp\" + DokName + ".docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=14
' Close the resulting document
ActiveWindow.Close
' Now, back in the template document, advance to next record
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
End Sub
Thanks for that roryspop,
I ended up swapping the for loop with
Set Source = ActiveDocument
'The for loop was "To ActiveDocument.MailMerge.DataSource.RecordCount" but for
'some reason RecordCount returned -1 every time, so I set ActiveRecord
'to wdLastRecord and then use that in the for loop.
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
For i = 1 To ActiveDocument.MailMerge.DataSource.ActiveRecord
ActiveDocument.MailMerge.DataSource.ActiveRecord = i
Set Letter = Source.Range
For Each oField In Letter.Fields
The rest of the code is the same, it's not very neat and I'm sure there must be a better way of doing things but it works.
The accepted solution did not work for me. I am using Word 2010. I managed to get a solution working and would like to share it here, so others can benefit from it:
'purpose: save each letter generated after mail merge in a separate file
' with the file name equal to first line of the letter.
'
'1. Before you run a mail merge make sure that in the main document you will
' end your letter with a Section Break (this can be found under
' Page Layout/Breaks/Section Break Next Page)
'2. Furthermore the first line of your letter contains the proposed file name
' and put an enter after it. Make the font of the filename white, to make it
' is invisible to the receiver of the letter. You can also include a folder
' name if you like.
'3. Run the mail merge as usual. A file which contains all the letters is
' generated.
'4. Add this module to the generated mail merge file. Use Alt-F11 to go to the
' visual basic user interface, right click in the left pane on the generated
' file and click on Import File and import this file
'5. save the generate file with all the letters as ‘Word Macro Enabled doc
' (*.docm)’.
'6. close the file.
'7. open the file again, click allow content when a warning about macro's is
' shown.
'8. execute the macro with the name SaveRecsAsFiles
Sub SaveRecsAsFiles()
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
End Sub
Private Sub AllSectionsToSubDoc(ByRef doc As Word.Document)
Dim secCounter As Long
Dim NrSecs As Long
NrSecs = doc.Sections.Count
'Start from the end because creating
'Subdocs inserts additional sections
For secCounter = NrSecs - 1 To 1 Step -1
doc.Subdocuments.AddFromRange _
doc.Sections(secCounter).Range
Next secCounter
End Sub
Private Sub SaveAllSubDocs(ByRef doc As Word.Document)
Dim subdoc As Word.Subdocument
Dim newdoc As Word.Document
Dim docCounter As Long
Dim strContent As String, strFileName As String
docCounter = 1
'Must be in MasterView to work with
'Subdocs as separate files
doc.ActiveWindow.View = wdMasterView
For Each subdoc In doc.Subdocuments
Set newdoc = subdoc.Open
'retrieve file name from first line of letter.
strContent = newdoc.Range.Text
strFileName = Mid(strContent, 1, InStr(strContent, Chr(13)) - 1)
'Remove NextPage section breaks
'originating from mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:=strFileName
.Close
End With
docCounter = docCounter + 1
Next subdoc
End Sub
Private Sub RemoveAllSectionBreaks(doc As Word.Document)
With doc.Range.Find
.ClearFormatting
.Text = "^b"
With .Replacement
.ClearFormatting
.Text = ""
End With
.Execute Replace:=wdReplaceAll
End With
End Sub
Part of the code I copied from here