Is there any way to access the size of a content control. In a Word document, I've added a Picture Content Control and resized it. In code, I delete the image and the content control automatically resizes. Is there way a to set the size in code? Is there a way to specify the default size of a Picture Content Control so that when there is no image, it uses that size?
contentField.range.InlineShapes.Item(1).Delete
I use this function to set the image and size of a content control image:
Private Function insertPicture(tgtDoc As Word.Document, varname As String, file As String, Optional picH As Double = -1)
Dim tcc As ContentControl, ccList As ContentControls
Set ccList = tgtDoc.SelectContentControlsByTitle(varname)
If ((varname <> "") And (Dir(file) <> "")) Then
For Each tcc In ccList
If tcc.Type = wdContentControlPicture Then
Debug.Print "inserting image from " & file
Dim picShape As InlineShape
Set picShape = tgtDoc.InlineShapes.AddPicture(file, True, True, tcc.Range)
picShape.LockAspectRatio = msoTrue
If picH > -1 Then
picShape.height = picH
End If
End If
Next tcc
Else
Debug.Print "No value set for " & varname
End If
End Function
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
I am trying to generate multiple Word documents which have content controls that are populated from an Excel file. The second content control needs to be populated with a list which varies in length.
How do I add each value to the content control instead of replacing the current value? I am currently using Rich Text Content Controls.
Here is what I have so far:
Sub CreateCoverLetters()
Dim objWord As Word.Application
Dim wDoc As Word.Document
Dim Rows As Integer
Set objWord = CreateObject(Class:="Word.Application")
objWord.Visible = True
Set wDoc = objWord.Documents.Open(*insert filepath*)
objWord.Activate
wDoc.ContentControls(1).Range.Text = Worksheets("Lists").Range("A2").Value
Rows = Worksheets("Lists").Range("A3", Range("A3").End(xlDown)).Rows.Count
r = 3
For i = 1 To Rows
wDoc.ContentControls(2).Range.Text = Worksheets("Lists").Cells(r, 1).Value
r = r + 1
Next
wDoc.SaveAs (*insert filepath*)
End Sub
Any help much appreciated!
Solved it as follows:
Sub CreateCoverLetters()
Dim objWord As Word.Application
Dim wDoc As Word.Document
Dim Rows As Integer
Dim Content As String
Set objWord = CreateObject(Class:="Word.Application")
objWord.Visible = True
Set wDoc = objWord.Documents.Open(*insert filepath*)
objWord.Activate
wDoc.ContentControls(1).Range.Text = Worksheets("Lists").Range("A2").Value
Rows = Worksheets("Lists").Range("A3", Range("A3").End(xlDown)).Rows.Count
r = 3
For i = 1 To Rows
Content = Content & "- " & Worksheets("Lists").Cells(r, 1).Value & vbNewLine
r = r + 1
Next
wDoc.ContentControls(2).Range.Text = Content
wDoc.SaveAs (*insert filepath*)
End Sub
The approach in user's answer works if the content can 1) be concatenated in a single string and 2) none of the elements require special formatting. This would also be the fastest approach.
If for any reason this process is not possible, then the way to "append" content without replacing goes something like in the code snippet that follows.
Notice how Range and ContentControl objects are declared and instantiated, especially the Range object. This makes it much easier to pick up the "target" at a later point in the code. Also, a Range object can be collapsed (think of it like pressing the right-arrow to make a selection a blinking cursor): this makes it possible to append content and work with that new content (format it, for example). Word also has a Range.InsertAfter method which can be used if the new content does not have to be manipulated in any special way.
Dim cc as Object ' Word.ContentControl
Dim rngCC as Object 'Word.Range
Set cc = wDoc.ContentControls(1).Range
Set rngCC = cc.Range
rngCC.Text = Worksheets("Lists").Range("A2").Value
'Add something at a later point
rngCC.Collapse wdCollapseEnd
rngCC.Text = " New material at the end of the content control."
I have an application that will fill out the To/Subject/Body of an outlook email:
Dim App As New Outlook.Application
Dim MailItem As Outlook._MailItem = DirectCast(App.CreateItem(Outlook.OlItemType.olMailItem), Outlook._MailItem)
Dim appDataDir As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) + "\Microsoft\Signatures"
Dim Signature As String = String.Empty
Dim diInfo As New DirectoryInfo(appDataDir)
If diInfo.Exists Then
Dim fiSignature As FileInfo() = diInfo.GetFiles("*.htm")
If fiSignature.Length > 0 Then
Dim sr As New StreamReader(fiSignature(0).FullName, Encoding.[Default])
Signature = sr.ReadToEnd()
If Not String.IsNullOrEmpty(Signature) Then
Dim fileName As String = fiSignature(0).Name.Replace(fiSignature(0).Extension, String.Empty)
Signature = Signature.Replace(fileName & Convert.ToString("_files/"), (Convert.ToString(appDataDir & Convert.ToString("/")) & fileName) + "_files/")
End If
End If
End If
With MailItem
.To = "asdf"
.Subject = "asdf"
.Body = txtTemplatePreview.Text & vbNewLine
End With
MailItem.Display(True)
So the function of the first If Then statement is to append my default signature to the end of the email. However, when this code is run, the signature that is appended looks to be HTML code instead of the signature itself.
In addition, I'm told that the first If Then statement will fail if the user has more than one signature. Is there a way to circumvent this?
Work with HTMLBody Property
The property Returns or sets a String representing the HTML body of the specified item. The HTMLBody property should be an HTML syntax string. Read/write.
There is no need to do any of that - the signature is added automatically when Display is called if you do not set the Body or HTMLBody property before that.
I have a few Word documents, each containing a few hundreds of pages of scientific data which includes:
Chemical formulae (H2SO4 with all proper subscripts & superscripts)
Scientific numbers (exponents formatted using superscripts)
Lots of Mathematical Equations. Written using mathematical equation editor in Word.
Problem is, storing this data in the form of Word is not efficient for us. So we want to store all this information in a Database (MySQL). We want to convert these formatting to LaTex.
Is there any way to iterate through all the subcripts & superscripts & Equations using VBA?
What about iterating through mathematical equations?
Based on your comment on Michael's answer
No! I just want to replace content in the subscript with _{
subscriptcontent } and similarly superscript content with ^{
superscriptcontent }. That would be the Tex equivalent. Now, I'll just
copy everything to a text file which will remove the formatting but
leaves these characters. Problem solved. But for that I need to access
the subscript & superscript objects of document
Sub sampler()
Selection.HomeKey wdStory
With Selection.find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Superscript = True
.Replacement.Text = "^^{^&}"
.Execute Replace:=wdReplaceAll
.Font.Subscript = True
.Replacement.Text = "_{^&}"
.Execute Replace:=wdReplaceAll
End With
End Sub
EDIT
Or If you also want to convert OMaths to TeX / LaTeX, then do something like:
Iterate over Omaths > convert each to MathML > [save MathML to disk] + [put some mark-up in doc describing MathML file's reference in place of OMath] > convert Word files as text
Now prepare a converter like MathParser and convert MathML files to LateX.
Parse text file > search and replace LaTeX code accordingly.
For a completely different idea visit David Carlisle's blog, that might interest you.
UPDATE
The module
Option Explicit
'This module requires the following references:
'Microsoft Scripting Runtime
'MicroSoft XML, v6.0
Private fso As New Scripting.FileSystemObject
Private omml2mml$, mml2Tex$
Public Function ProcessFile(fpath$) As Boolean
'convPath set to my system at (may vary on your system):
omml2mml = "c:\program files\microsoft office\office14\omml2mml.xsl"
'download: http://prdownloads.sourceforge.net/xsltml/xsltml_2.0.zip
'unzip at «c:\xsltml_2.0»
mml2Tex = "c:\xsltml_2.0\mmltex.xsl"
Documents.Open fpath
'Superscript + Subscript
Selection.HomeKey wdStory
With Selection.find
.ClearFormatting
.Replacement.ClearFormatting
'to make sure no paragraph should contain any emphasis
.Text = "^p"
.Replacement.Text = "^&"
.Replacement.Font.Italic = False
.Replacement.Font.Bold = False
.Replacement.Font.Superscript = False
.Replacement.Font.Subscript = False
.Replacement.Font.SmallCaps = False
.Execute Replace:=wdReplaceAll
.Font.Italic = True
.Replacement.Text = "\textit{^&}"
.Execute Replace:=wdReplaceAll
.Font.Bold = True
.Replacement.Text = "\textbf{^&}"
.Execute Replace:=wdReplaceAll
.Font.SmallCaps = True
.Replacement.Text = "\textsc{^&}"
.Execute Replace:=wdReplaceAll
.Font.Superscript = True
.Replacement.Text = "^^{^&}"
.Execute Replace:=wdReplaceAll
.Font.Subscript = True
.Replacement.Text = "_{^&}"
.Execute Replace:=wdReplaceAll
End With
Dim dict As New Scripting.Dictionary
Dim om As OMath, t, counter&, key$
key = Replace(LCase(Dir(fpath)), " ", "_omath_")
counter = 0
For Each om In ActiveDocument.OMaths
DoEvents
counter = counter + 1
Dim tKey$, texCode$
tKey = "<" & key & "_" & counter & ">"
t = om.Range.WordOpenXML
texCode = TransformString(TransformString(CStr(t), omml2mml), mml2Tex)
om.Range.Select
Selection.Delete
Selection.Text = tKey
dict.Add tKey, texCode
Next om
Dim latexDoc$, oPath$
latexDoc = "\documentclass[10pt]{article}" & vbCrLf & _
"\usepackage[utf8]{inputenc} % set input encoding" & vbCrLf & _
"\usepackage{amsmath,amssymb}" & vbCrLf & _
"\begin{document}" & vbCrLf & _
"###" & vbCrLf & _
"\end{document}"
oPath = StrReverse(Mid(StrReverse(fpath), InStr(StrReverse(fpath), "."))) & "tex"
'ActiveDocument.SaveAs FileName:=oPath, FileFormat:=wdFormatText, Encoding:=1200
'ActiveDocument.SaveAs FileName:=oPath, FileFormat:=wdFormatText, Encoding:=65001
ActiveDocument.Close
Dim c$, i
c = fso.OpenTextFile(oPath).ReadAll()
counter = 0
For Each i In dict
counter = counter + 1
Dim findText$, replaceWith$
findText = CStr(i)
replaceWith = dict.item(i)
c = Replace(c, findText, replaceWith, 1, 1, vbTextCompare)
Next i
latexDoc = Replace(latexDoc, "###", c)
Dim ost As TextStream
Set ost = fso.CreateTextFile(oPath)
ost.Write latexDoc
ProcessFile = True
End Function
Private Function CreateDOM()
Dim dom As New DOMDocument60
With dom
.async = False
.validateOnParse = False
.resolveExternals = False
End With
Set CreateDOM = dom
End Function
Private Function TransformString(xmlString$, xslPath$) As String
Dim xml, xsl, out
Set xml = CreateDOM
xml.LoadXML xmlString
Set xsl = CreateDOM
xsl.Load xslPath
out = xml.transformNode(xsl)
TransformString = out
End Function
The calling(from immediate window):
?ProcessFile("c:\test.doc")
The result would be created as test.tex in c:\.
The module may need to fix some places. If so let me know.
The Document object in Word has a oMaths collection, which represents all oMath objects in the document. The oMath object contains the Functions method which will return a collection of Functions within the oMath object. So, the equations shouldn't be that big of an issue.
I imagine you want to capture more than just the subscripts and superscripts, though, that you would want the entire equation containing those sub and superscripts. That could be more challenging, as you'd have to define a starting and ending point. If you were to use the .Find method to find the subscripts and then select everything between the first space character before it and the first space character after it, that might work, but only if your equation contained no spaces.
This VBA sub should go through every text character in your document and remove the superscript and subscript while inserting the LaTeX notation.
Public Sub LatexConversion()
Dim myRange As Word.Range, myChr
For Each myRange In ActiveDocument.StoryRanges
Do
For Each myChr In myRange.Characters
If myChr.Font.Superscript = True Then
myChr.Font.Superscript = False
myChr.InsertBefore "^"
End If
If myChr.Font.Subscript = True Then
myChr.Font.Subscript = False
myChr.InsertBefore "_"
End If
Next
Set myRange = myRange.NextStoryRange
Loop Until myRange Is Nothing
Next
End Sub
If some equations were created with Word's built in equation editor or via building blocks (Word 2010/2007) and exist inside content controls the above will not work. These equations will either require separate VBA conversion code or manual conversion to text only equations prior to executing the above.
C# implemetation of OpenMath (OMath) to LaTex using Open XML SDK.
Download MMLTEX XSL files from here http://sourceforge.net/projects/xsltml/
public void OMathTolaTeX()
{
string OMath = "";
string MathML = "";
string LaTex = "";
XslCompiledTransform xslTransform = new XslCompiledTransform();
// The MML2OMML.xsl file is located under
// %ProgramFiles%\Microsoft Office\Office12\
// Copy to Local folder
xslTransform.Load(#"D:\OMML2MML.XSL");
using (WordprocessingDocument wordDoc =
WordprocessingDocument.Open("test.docx", true))
{
OpenXmlElement doc = wordDoc.MainDocumentPart.Document.Body;
foreach (var par in doc.Descendants<Paragraph>())
{
var math in par.Descendants<DocumentFormat.OpenXml.Math.Paragraph>().FirstOrDefault();
File.WriteAllText("D:\\openmath.xml", math.OuterXml);
OMath = math.OuterXml;
}
}
//Load OMath string into stream
using (XmlReader reader = XmlReader.Create(new StringReader(OMath)))
{
using (MemoryStream ms = new MemoryStream())
{
XmlWriterSettings settings = xslTransform.OutputSettings.Clone();
// Configure xml writer to omit xml declaration.
settings.ConformanceLevel = ConformanceLevel.Fragment;
settings.OmitXmlDeclaration = true;
XmlWriter xw = XmlWriter.Create(ms, settings);
// Transform our MathML to OfficeMathML
xslTransform.Transform(reader, xw);
ms.Seek(0, SeekOrigin.Begin);
StreamReader sr = new StreamReader(ms, Encoding.UTF8);
MathML= sr.ReadToEnd();
Console.Out.WriteLine(MathML);
File.WriteAllText("d:\\MATHML.xml", MathML);
// Create a OfficeMath instance from the
// OfficeMathML xml.
sr.Close();
reader.Close();
ms.Close();
// Add the OfficeMath instance to our
// word template.
}
}
var xmlResolver = new XmlUrlResolver();
xslTransform = new XslCompiledTransform();
XsltSettings xsltt = new XsltSettings(true, true);
// The mmtex.xsl file is to convert to Tex
xslTransform.Load("mmltex.xsl", xsltt, xmlResolver);
using (XmlReader reader = XmlReader.Create(new StringReader(MathML)))
{
using (MemoryStream ms = new MemoryStream())
{
XmlWriterSettings settings = xslTransform.OutputSettings.Clone();
// Configure xml writer to omit xml declaration.
settings.ConformanceLevel = ConformanceLevel.Fragment;
settings.OmitXmlDeclaration = true;
XmlWriter xw = XmlWriter.Create(ms, settings);
// Transform our MathML to OfficeMathML
xslTransform.Transform(reader, xw);
ms.Seek(0, SeekOrigin.Begin);
StreamReader sr = new StreamReader(ms, Encoding.UTF8);
LaTex = sr.ReadToEnd();
sr.Close();
reader.Close();
ms.Close();
Console.Out.WriteLine(LaTex);
File.WriteAllText("d:\\Latex.txt", LaTex);
// Create a OfficeMath instance from the
// OfficeMathML xml.
// Add the OfficeMath instance to our
// word template.
}
}
}
Hope this helps for C# developers.