I'm trying to write a macro which will insert textboxes in a Word document, and format them with in-line-with-text text wrapping.
Here's my code so far:
Sub Example()
Dim newTextbox As Shape
For I = 1 To 10
Set newTextbox = ActiveDocument.Shapes.AddTextbox _
(Orientation:=msoTextOrientationHorizontal, _
Left:=0, Top:=0, Width:=100, Height:=50)
newTextbox.WrapFormat.Type = wdWrapInline
newTextbox.TextFrame.TextRange = I
Next
End Sub
The issue I'm having is that instead of each textbox being added to the start of document, as is currently happening, I need it to be added to the end. I understand that in the example I've given, I could simply use For I = 10 To 1 Step -1. However, due to my use of the textboxes in the actual project I'm working on, this is not possible.
I have spent a few hours playing with the code but just haven't been able to figure it out. Thanks in advance for any help.
Josh.
Joshua, here is a final working code:
Sub InsertInlineTextBox()
' Move all the text after the cursor to a new paragraph
' and jump to the start point of this paragraph
Selection.InsertParagraphAfter
Selection.MoveDown Unit:=wdParagraph, count:=1
Dim aShape As Shape
' Insert the shape at the current cursor position +1 point down in vertical
' direction to prevent automatic moving the shape to the previous paragraph
' during 'inlining'
Set aShape = ActiveDocument.Shapes.AddTextbox( _
msoTextOrientationHorizontal, _
Selection.Information(wdHorizontalPositionRelativeToPage), _
Selection.Information(wdVerticalPositionRelativeToPage) + 1, 400, 60)
With aShape
.TextFrame.MarginBottom = 0 ' adjust text margins
.TextFrame.MarginLeft = 0
.TextFrame.MarginRight = 0
.TextFrame.MarginTop = 0
.Line.Visible = msoFalse ' don't show the border
' converting to InlineShape will place
' the shape at the start point of paragraph
.ConvertToInlineShape
End With
' Remove carriege return before the shape
Selection.EndOf Unit:=wdParagraph, Extend:=wdMove
Selection.MoveLeft Unit:=wdCharacter, count:=1
Selection.Delete Unit:=wdCharacter, count:=1
End Sub
I also use this macro to disable spell check in the textboxes
because usually they contain a bunch of C++ example code:
Sub NoSpellCheck()
Selection.Range.SpellingChecked = True
Selection.Range.NoProofing = True
End Sub
Related
I need to color text in a word document (code snippets) red up until the colon, then after the colon it needs to be blue until a comma or ending paren in each line (or selection).
I've been using "selection" and trying to use the move function to start up with the blue. But I'm new to VBA and all the tutorials are confusing to me as to how to tell it when to start and stop with specific formatting.
I found this that I thought might be a helpful bit, but when I put a comma in instead of a _ VB was unhappy with me.
Selection.MoveRight Unit:=wdCharacter, Count:=1, _
Extend:=wdExtend
If by each line you refer to paragraphs in word then the simple code may serve your purpose
Sub TestColorPara()
Dim Para As Paragraph, Rng As Range, ColonAt As Long, CommaAt As Long
For Each Para In Selection.Paragraphs
Ln = Para.Range.Characters.Count
If Ln > 1 Then
ColonAt = InStr(1, Para.Range.Text, ":")
If ColonAt > 0 Then
Set Rng = ActiveDocument.Range(Start:=Para.Range.Start, End:=Para.Range.Start + ColonAt)
Rng.Font.Color = wdColorRed
CommaAt = InStr(ColonAt, Para.Range.Text, ",")
CommaAt = IIf(CommaAt > 0, CommaAt, Ln - 1)
Set Rng = ActiveDocument.Range(Start:=Para.Range.Start + ColonAt, End:=Para.Range.Start + CommaAt)
Rng.Font.Color = wdColorBlue
End If
End If
Next
End Sub
Tested to achieve what I understand as your requirement.
So I am trying to write a code that adds a text box above a table on each page in a word document. This text box is to be centered to align with the table (I have no issues generating a centered table on each page). I have just recently started working in VBA so my knowledge is a little bit lacking. Here is my code so far, it is kind of a mish mash of what I could find online.
Sub TextMaker()
'
' TextMaker Macro
'
'
Dim i As Long, Rng As Range, Shp As Shape
Dim objDoc As Document
Dim objTextBox As Shape
Set objDoc = ActiveDocument
With ActiveDocument
For i = 1 To 5
Set Rng = .GoTo(What:=wdGoToPage, Name:=i)
Set Shp = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=InchesToPoints(0.1), Top:=InchesToPoints(1.44), Width:=InchesToPoints(7.65), Height:=InchesToPoints(0.29), Anchor:=Rng)
With Shp
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = InchesToPoints(1.44)
With .TextFrame.TextRange
.Text = "Ref. No.: T" & vbCr & "Signature "
Set Rng = .Paragraphs.First.Range
With Rng
.Font.ColorIndex = wdRed
.End = .End - 1
.Collapse wdCollapseEnd
End With
End With
End With
Next
End With
End Sub
The output works for the first two pages but on the 3rd page the alignment of the text box is not centered. I checked the positioning and the text box still says it is centered relative to page even though it is not.
The code works properly as long as the tables are not inserted, but the table generating code, if run after this one, does not put the tables on the same page as text boxes.
This is the 3rd page of my document, where things start to go wrong. The text box should be positioned above the table and centered in line with it.
In order to reproduce the document, create a blank document and run this table generation code:
Sub TableMaker()
For i = 1 To 5
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=6, NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Selection.Tables(1).Columns(1).Width = InchesToPoints(1.39)
Selection.Tables(1).Columns(2).Width = InchesToPoints(6.26)
Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
With Selection.Tables(1).Rows
.WrapAroundText = True
.VerticalPosition = InchesToPoints(1.82)
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.DistanceTop = InchesToPoints(0)
.DistanceBottom = InchesToPoints(0)
.AllowOverlap = False
End With
'place cursor at end of page
Selection.EndKey Unit:=wdStory
'insert page break
Selection.InsertBreak Type:=wdPageBreak
Next i
End Sub
Or run the text generation code above and then this table generation code. Either way the formatting is not consistent. There will be no other text on these documents but an image will be placed below the tables on each page.
The problem is a combination of factors:
the table having text flow formatting. If I set that to "none" the textbox is centered correctly.
if the anchor range is outside the table, it works
I then tested the following and determined that the problem is because "Layout in cell" is activated (thanks for that screen shot BTW). When I put that in (see below) the text box is centered on the page because it's positioning is now independent of the table.
With Shp
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = InchesToPoints(1.44)
.LayoutInCell = False
I want to make a macro that will do the following:
Highlight every nth selection.
Check that selection to ensure it is a word (and not numerical or punctuation).
Cut the word and paste it into another document.
Replace the word with a blank space.
Repeat until the end of the document.
The hard part is checking a selection to validate that it is indeed a word and not something else.
I found some code written by someone else that might work, but I don't understand how to implement it in my macro with the rest of the commands:
Function IsLetter(strValue As String) As Boolean
Dim intPos As Integer
For intPos = 1 To Len(strValue)
Select Case Asc(Mid(strValue, intPos, 1))
Case 65 To 90, 97 To 122
IsLetter = True
Case Else
IsLetter = False
Exit For
End Select
Next
End Function
Sub Blank()
Dim OriginalStory As Document
Set OriginalStory = ActiveDocument
Dim WordListDoc As Document
Set WordListDoc = Application.Documents.Add
Windows(OriginalStory).Activate
sPrompt = "How many spaces would you like between each removed word?"
sTitle = "Choose Blank Interval"
sDefault = "8"
sInterval = InputBox(sPrompt, sTitle, sDefault)
Selection.HomeKey Unit:=wdStory
Do Until Selection.Bookmarks.Exists("\EndOfDoc") = True
Selection.MoveRight Unit:=wdWord, Count:=sInterval, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
If IsLetter = True Then
Selection.Cut
Selection.TypeText Text:="__________ "
Windows(WordListDoc).Activate
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.TypeParagraph
Windows(OriginalStory).Activate
Else
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Loop
Loop
End Sub
The function should sit 'above' the rest of the code right? But I get an error 'argument not optional' when I run it.
Any ideas or tips much appreciated.
I think the code below will do most of what you want. Note that some of the comments relate to the reasons for which I discarded some of your code while others may prove helpful in understanding the present version.
Sub InsertBlanks()
' 02 May 2017
Dim Doc As Document
Dim WordList As Document
Dim Rng As Range
Dim Interval As String, Inter As Integer
Dim Wd As String
' you shouldn't care which Window is active,
' though it probably is the one you want, anyway.
' The important thing is which document you work on.
' Windows(OriginalStory).Activate
Set Doc = ActiveDocument
Application.ScreenUpdating = False
Set WordList = Application.Documents.Add
' If you want to use all these variables you should also declare them.
' However, except for the input itself, they are hardly necessary.
' sPrompt = "How many spaces would you like between each removed word?"
' sTitle = "Choose Blank Interval"
' sDefault = "8"
Do
Interval = InputBox("How many retained words would you like between removed words?", _
"Choose Blank Interval", CStr(8))
If Interval = "" Then Exit Sub
Loop While Val(Interval) < 4 Or Val(Interval) > 25
Inter = CInt(Interval)
' you can modify min and max. Exit by entering a blank or 'Cancel'.
' You don't need to select anything.
' Selection.HomeKey Unit:=wdStory
Set Rng = Doc.Range(1, 1) ' that's the start of the document
' Set Rng = Doc.Bookmarks("James").Range ' I used another start for my testing
Do Until Rng.Bookmarks.Exists("\EndOfDoc") = True
Rng.Move wdWord, Inter
Wd = Rng.Words(1)
If Asc(Wd) < 65 Then
Inter = 1
Else
Set Rng = Rng.Words(1)
With Rng
' replace Len(Wd) with a fixed number of repeats,
' if you don't want to give a hint about the removed word.
.Text = String(Len(Wd) - 1, "_") & " "
.Collapse wdCollapseEnd
End With
With WordList.Range
If .Words.Count > 1 Then .InsertAfter Chr(11)
.InsertAfter Wd
End With
Inter = CInt(Interval)
End If
Loop
Application.ScreenUpdating = True
End Sub
In order to avoid processing non-words my above code tests, roughly, if the first character is a letter (ASCII > 64). This will preclude numbers and it will allow a lot of symbols. For example "€100" would be accepted for replacement but not "100". You may wish to refine this test, perhaps creating a function like you originally did. Another way I thought of would be to exclude "words" of less than 3 characters length. That would eliminate CrLf (if Word considers that one word) but it would also eliminate a lot of prepositions which you perhaps like while doing nothing about "€100". It's either very simple, the way I did it, or it can be quite complicated.
Variatus - thank you so much for this. It works absolutely perfectly and will be really useful for me.
And your comments are helpful for me to understand some of the commands you use that I am not familiar with.
I'm very grateful for your patience and help.
I am trying to create two keyboard shortcuts which allow me to move selected words quickly to the right and left within a text. The selected text should move one word to the left or the right.
Here is what I want to do
1) Select words e.g. “this is” in the sentence “this is a tree”
2) Press e.g. ctrl + alt + arrow to the right
3) The sentence reads now as “a this is tree”
4) Press again ctrl alt + arrow to the right
5) The sentence reads now as “a tree this is”
The idea is to replace the cut / paste steps and make the process a bit more efficient and smoother.
I have no knowledge in VB, but managed to get close to by using Word’s macro-function.
Sub moveRight()
'moveRight Macro
Selection.Cut
Selection.moveRight Unit:=wdWord, Count:=1
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End Sub
The problem with this function is that the selected words are no longer selected once they are pasted. Hence, triggering the function again (=moving the text more than one word) results in an error (I would have to select the relevant text again). Is there any way that the selected words remain selected after they are pasted so that I can trigger the function repeatedly?
Many thanks.
You might like to try this solution. The first two procedures below should be called by your keyboard shortcuts. The both call the same executing sub, but with different parameters.
Sub MoveSelectionLeft()
' call with keyboard shortcut
GetSelection True
End Sub
Sub MoveSelectionRight()
' call with keyboard shortcut
GetSelection False
End Sub
Private Sub GetSelection(ByVal ToLeft As Boolean)
' 22 Apr 2017
Dim Rng As Range
Dim SelTxt As String ' selected text (trimmed)
Dim Sp() As String
Set Rng = Selection.Range
With Rng
SelTxt = Trim(.Text)
If ToLeft Then
.MoveStart wdWord, -1
Else
.MoveEnd wdWord, 1
End If
Sp = Split(Trim(.Text))
If ToLeft Then
.Text = SelTxt & " " & Sp(0) & " "
Else
.Text = Sp(UBound(Sp)) & " " & SelTxt & " "
End If
.Find.Execute SelTxt
.Select
End With
End Sub
A cheap way of doing this is with bookmarks. At some point before and after moving the text, run AddBookMark and DeleteBookMark respectively.
Public Sub AddBookMark()
Dim myDocument As Document
Set myDocument = ActiveDocument
myDocument.Bookmarks.Add "MySelectedText", Selection
End Sub
Public Sub DeleteBookMark()
Dim myDocument As Document
Set myDocument = ActiveDocument
myDocument.Bookmarks("MySelectedText").Delete
End Sub
Sub moveRight()
Dim myDocument As Document
Set myDocument = ActiveDocument
Selection.Cut
Selection.moveRight Unit:=wdWord, Count:=1
Selection.PasteAndFormat (wdFormatOriginalFormatting)
myDocument.Bookmarks("MySelectedText").Select
End Sub
I have a report that is built from Excel and outputs in Word, I also have a picture called "Picture 7". My question is once this is pasted into word from excel is there anyway to center align the picture?
the picture is copied over as part of a range of cells. So I would need to reference the picture in word.
It is centered on the range of cells but does not quite come out center in the word document
Edit: Currently I am trying this
For Each shp In oDoc.Shapes
If Left(shp.Name, 7) = "RN Logo" Then
shp.Left = wdShapeCenter
End If
Next
But this is just putting the picture in the top left, I think because of the table it is pasted with I may need to do an absolute position on it.
Edit 2:I have found a work around but it is just a large If/Else and absolute positioning, snippet below
Sub Update_RN_Logo_Location()
For Each shp In oDoc.Shapes
If Left(shp.Name, 7) = "RN Logo" Then
If Right(shp.Name, 1) = 1 Then
shp.Left = oWord.CentimetersToPoints(2.4)
Else
shp.Left = oWord.CentimetersToPoints(0.75)
End If
ElseIf Left(shp.Name, 4) = "UKAS" Then
If Right(shp.Name, 1) = 1 Then
shp.Left = oWord.CentimetersToPoints(1.25)
ElseIf Right(shp.Name, 1) = 2 Then
shp.Left = oWord.CentimetersToPoints(2.5)
ElseIf Right(shp.Name, 1) = 3 Then
shp.Left = oWord.CentimetersToPoints(0)
ElseIf Right(shp.Name, 1) = 4 Then
shp.Left = oWord.CentimetersToPoints(2.5)
End If
End If
Next
End Sub
Picture of the document with some removed sensitive information
I believe there are two issues here. First, graphics in word have an anchor. When the graphic is pasted, the anchor for it is placed in the table created by Excel's cells. This throws off positioning.
Second, I suggest using the Shape.RelativeHorizontalPosition property, which will allow your Shape.Left property to give you a true center alignment relative to another page element.
In the code below I am positioning the graphic relative to the document's margins, but there are other choices:
Word 2007 WdRelativeHorizontalPosition Enumeration
This enumeration will also work for Word 2010 and 2013.
To assure proper placement of the logo graphic, insert a carriage return at the top of the document prior to pasting in your logo and table (make sure this carriage return has no indents or styles that apply spatial formatting):
Selection.HomeKey Unit:=wdStory
Selection.InsertBefore vbCr
Then paste in the graphic and table and run this code:
For Each shp In oDoc.Shapes
If Left(shp.Name, 7) = "RN Logo" Then
With shp
.Select
Selection.Cut
Selection.HomeKey Unit:=wdStory
Selection.Paste 'places graphic on carriage return before table
.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
.Left = wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
'.Top = measurement of choice
End With
End If
Next
Have you tried simply center-aligning the default paragraph (or adding a text box) and pasting in the picture? Keep the picture separate from everything else. You may need to set a text run-around as well.
This is slightly-modified recorded Word VBA
Sub Macro1()
ActiveDocument.Paragraphs.Alignment = wdAlignParagraphCenter
ActiveDocument.InlineShapes.AddPicture FileName:= _
"C:\Users\user\Desktop\01.jpg", LinkToFile:=False, _
SaveWithDocument:=True
End Sub
You could just do a "Control+A" select all and then allign everything to center:
Sub Testing()
'Select All:
Selection.WholeStory
'Center Align All:
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub
I'd prefer to insert pictures from outside Excel/Word;
You can position them exactly in the paragraph you want:
Sub M_snb()
ActiveDocument.Paragraphs(5).Range.InlineShapes.AddPicture("G:\Excel_.bmp").Range.ParagraphFormat.Alignment = 1
End Sub