Remove the "same as the whole table" property from Outlook table - vba

I've got the following code to "Codeize" a block of code in an outlook message:
On Error GoTo Catch
Dim oSelection As Word.Selection
Set oSelection = Application.ActiveInspector.CurrentItem.GetInspector.WordEditor.Application.Selection
With oSelection
With .Font
.Name = "Courier New"
'.Color = 10027008 '13369344
.Size = 10
End With
End With
Dim oTable As Word.Table
Set oTable = oSelection.ConvertToTable(, 1, 1)
With oTable
.Borders.OutsideLineStyle = wdLineStyleDot
.Shading.BackgroundPatternColor = wdColorGray05
.TopPadding = InchesToPoints(0.1)
.BottomPadding = InchesToPoints(0.1)
.LeftPadding = InchesToPoints(0.2)
.RightPadding = InchesToPoints(0.05)
End With
Works great, BUT I think I cannot get the margins to work because I'm missing whatever removes the "Same as the whole table" property.
After the code runs, the Table Properties looks like this:
Perhaps I'm just setting the margins wrong, and this will automatically go away? What am I missing?

Word provides a macro recorder which allows to generate the VBA code in the background. Try to record a VBA macro in Word and see what properties should be used for that. See Record or run a macro for more information.

My bad,
Turns out that setting the padding is the way to turn off this property. The problem was actually in the InchesToPoints call that I copied and pasted from when I macro recording in MS Word.
However InchesToPoints is/was not an available method and that issue was hidden by the first line of my code:
On Error Goto Catch
(Shoot me now!)
So, InchesToPoints failed, which means the padding was NOT actually getting set. I made my own InchesToPoints method:
Public Function InchesToPoints(ByVal dInches As Double) As Double
Const INCHES_TO_POINTS = 72#
InchesToPoints = dInches * INCHES_TO_POINTS
End Function
And now it all works just fine.
The actual correct answer to this question is setting the table padding (E.g., .TopPadding = 7.2 will turn off the "Same as the whole table" property.
Have a nice day.

Related

How to apply Style in VBA to a textbox on a userform?

I have this code for a textbox.
Dim TextBox15 As Range
ActiveDocument.Variables("bmagicf").Value = Me.TextBox15.Value
Me.TextBox15.Value = Me.TextBox15.Text
With ActiveDocument
.Fields.Update
End With
How can I apply a style to it in the same sense as the code below?
Dim ComboBox9 As Range
Set ComboBox9 = ActiveDocument.Bookmarks("bmagich").Range
ComboBox9.Text = Me.ComboBox9.Value
If Me.ComboBox9.Value = "No" Then
ComboBox9.Text = "Appendices"
ComboBox9.Style = ActiveDocument.Styles("Style 22")
End If
I tried the code below but had no luck:
Dim TextBox15 As Range
ActiveDocument.Variables("bmagicf").Value = Me.TextBox15.Value
Me.TextBox15.Value = Me.TextBox15.Text
Textbox15.Style = ActiveDocument.Styles("Style 22")
With ActiveDocument
.Fields.Update
End With
Your question is extremely misleading, and your code is confusing.
From looking at your code it appears that you are not trying to apply a Style to a text box on a User Form, though the title of your question says you are.
Your code is confusing because you have used the same name for several different things.
Your code isn’t working because you have missed a line of code. Look again at the combo box example. The second line is crucial.
Set ComboBox9 = ActiveDocument.Bookmarks("bmagich").Range
You need a line of code like that for your text box example, otherwise the Range variable, TextBox15, doesn’t point to anything.

How can i change every occurence of a specific font ind a Word document?

i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).
Everything works as intended except for one thing.
This here is the code i am using to exchange every occurence of the found
font in the document:
For i = 0 To UBound(missingFont)
For Each oCharacter In ActiveDocument.Range.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?
First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.
It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...
But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.
The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)
Sub ProcessAllStories()
Dim doc as Word.Document
Dim missingFont as Variant
Dim myStoryRange as Word.StoryRange
'Define missingFont
Set doc = ActiveDocument
For Each myStoryRange In doc.StoryRanges
CheckFonts myStoryRange, missingFont
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
CheckFonts myStoryRange, missingFont
Loop
Next myStoryRange
End Sub
Sub CheckFonts(rng as Word.Range, missingFont as Variant)
Dim oCharacter as Word.Range
For i = 0 To UBound(missingFont)
For Each oCharacter In rng.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
End Sub

MS Word updating links: Why does changing a .LinkFormat property reset field Index

I hope my first post will be OK and not offend (I've tried to follow the guide and done a lot of searching).
I've modified the below code from Greg Maxey (https://gregmaxey.com/word_tip_pages/word_fields.html) to update links in my Word document to an Excel workbook. It seems to be the most used code for this purpose. The reason I changed his code was to try to do away with the need to have a counter variable like i, and using a For i = 1 to .Fields.Count Then... Next i structure.
When I run it as is, it gets stuck in a loop only updating the first field in the Word document. To see this, I put in the Debug.Print wrdField.Index line. It repeatedly outputs 1, so it is not moving to the Next wrdField as I expect (the code actually just used Next, but it's the same result if I use Next wrdField).
When I comment out .AutoUpdate = False, it works properly:
Public Sub UpdateExternalLinksToCurrentFolder()
Dim wrdDocument As Word.Document
Dim wrdField As Word.Field
Dim strCurrentLinkedWorkbookPath, strNewLinkedWorkbookPath As String
Dim strCurrentLinkedWorkbookName, strNewLinkedWorkbookName As String
Dim strCurrentLinkedWorkbookFullName, strNewLinkedWorkbookFullName As String
Dim strThisDocumentPath As String
'On Error GoTo ErrorHandler_UpdateExternalLinksToCurrentFolder
Application.ScreenUpdating = False
Set wrdDocument = ActiveDocument
strThisDocumentPath = wrdDocument.Path & Application.PathSeparator
strNewLinkedWorkbookPath = strThisDocumentPath
With wrdDocument
For Each wrdField In .Fields
With wrdField
If .Type = wdFieldLink Then
With .LinkFormat
Debug.Print wrdField.Index
strCurrentLinkedWorkbookPath = .SourcePath & Application.PathSeparator
strCurrentLinkedWorkbookName = .SourceName
strNewLinkedWorkbookName = strCurrentLinkedWorkbookName
strNewLinkedWorkbookFullName = strNewLinkedWorkbookPath & strNewLinkedWorkbookName
.AutoUpdate = False
End With
.Code.Text = VBA.Replace(.Code.Text, Replace(strCurrentLinkedWorkbookPath, "\", "\\"), Replace(strNewLinkedWorkbookPath, "\", "\\"))
End If
End With
Next
End With
Set wrdDocument = Nothing
Application.ScreenUpdating = True
Exit Sub
Can anyone tell my why it's behaving this way? When I set .AutoUpdate = False, am I changing something about the link field or doing something to the Word document that causes the .wrdField.Index to reset to 1? I can't find anything online documenting this behavior and it's driving me nuts.
Behind the scenes, what's happening is that Word recreates the content and the field. The orginal linked content is removed and new content inserted. So that essentially destroys the field and recreates it. A user won't notice this, but VBA does.
When dealing with a loop situation that uses an index and the looped items are being removed, it's therefore customary to loop backwards (from the end of the document to the beginning). Which cannot be done with For...Each.

How to select a value from a DropDownList in a Word Macro using VBA?

I am creating a macro using both vbscript and vba, this macro is being called by the script code and works well but when I try to select a value outside the macro itself, I keep getting an error about the way im trying to set the value.
I have named the dropdownlist as "Result" and when I try to set the value it does not work, I also tried with the default name "DropDownList" , but none of those options seems to work, maybe i am missing object references.
I already declared the objects that I need
Set objWord = CreateObject("Word.Application")
Set activeDoc= objWord.ActiveDocument
activeDoc.FormFields("Result").DropDown.Value = 2
The error i am getting right now is that "The Requested memeber of the coleection does not exist."
The only solution I can come up with is to set the value when I'm creating the dropdown in the macro:
ActiveDocument.Tables(1).Cell(Row: = 4, Column: = 4).Select
Set objCC =
Selection.Range.ContentControls.Add(wdContentControlDropDownList)
With objCC
.Title = "Result"
.Tag = "Result"
.DropdownListEntries.Add("Passed", "Passed").Select
End with
I got everything messed up, but in the end I realized what was my mistake. I wasn't using the tag so the Item was loose, I had to use the index of the correct content control
Set objCc = activeDoc.ContentControls.Item(5)
Set objLe1 = objCc.DropdownListEntries.Item(1)
objLe1.Select
Thanks very much for your part of code, I have so much trouble to find how to do this !
I add just :
With ThisDocument.tables(blabla).Cell(x,y)
Set objCc = .Range.ContentControls.Item(1)
Set objLe1 = objCc.DropdownListEntries.Item(2)
objLe1.Select
End With
And it works perfectly within my project ! Ty again, see you !

moving paragraph up/down (without copy / paste)

In word I am looking for a keyboard short cut which allows me to move the paragraph in which my cursor currently is one paragraph/line up or down.
I am new to VBA etc, but found this
Sub OutlineMoveUp()
Selection.Range.Relocate wdRelocateUp
End Sub
This comes pretty close to what I am looking for, but seems to move the paragraph up according to its position in the outline structure (what can become rather confusing). I just want to move it one paragraph/line up or down (also irrespective of its formatting).
(RStudio offers this nice feature where you can simply move selected text lines without copy-pasting; I am looking for the equivalent in word).
many thx.
The Relocate method is designed to work in Outline mode see here. Try the Move method instead:
Selection.Range.Move Unit:=wdParagraph, Count:=-1
You may need to adjust Count to get the effect you desire --- if -1 doesn't work, try -2, etc.
This would probably be cleaner using cut/paste but try this:
Sub Test_NewP()
Dim doc As Word.Document
Dim CurR As Word.Range
Dim NewP As Word.Paragraph
Dim IndexP As Long
Set doc = ActiveDocument
If doc.ActiveWindow.View = wdOutlineView Then
MsgBox "This program doesn't work in outline view --- please switch to another view", vbOKOnly, "Error"
Exit Sub
End If
Set CurR = Selection.Paragraphs(1).Range
IndexP = doc.Range(0, CurR.End).Paragraphs.Count
Set NewP = doc.Paragraphs.Add(doc.Paragraphs(IndexP - 1).Range)
NewP.Range.Text = CurR.Text
CurR.Delete
Set NewP = Nothing
Set CurR = Nothing
Set doc = Nothing
End Sub
This likely won't reliably manage formatting, but you could add code to fix that.
Hope that helps.