i'm completely new to visual basic.
this is my first code.
I want to run a macro that inserts a horizontal line, (bottom border) and then adds a new line below that horizontal line.
i got this code to insert the horizontal line, but i dont know how to add the new line below that
thank you
`Sub BottomBorder()
Selection.MoveUp Unit:=wdParagraph, Count:=1
With Selection.Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = wdColorAutomatic
End With
End Sub
Related
I am trying to move down one cell in a word table using VBA; the problem is when I use the unit:=wdCell it gives me a run-time error. I can use the default wdLine and it works fine, but if the cell has more than one line, I end up on the second line instead of the next cell.
With Selection
.MoveDown Unit:=wdCell, Count:=1, Extend:=wdMove
.Expand wdCell
.Range.Text = "Hello World"
End With
For some reason, you cannot use wdCell as a parameter to Move*, which does not appear to be a documented fact.
One workaround would be to jump to the end of the cell and then move one line down:
With Selection
.MoveEnd wdCell
.MoveDown wdLine, Count:=1
.Expand wdCell
End With
Another workaround would be to locate yourself in the table and jump to the next cell by index:
With Selection
Dim r As Long, c As Long
r = .Rows(1).Index
c = .Columns(1).Index
If .Rows(1).Parent.Rows.Count >= r + 1 Then
.Rows(1).Parent.Rows(r + 1).Cells(c).Range.Select
End If
End With
I am trying to insert a new page in word i.e insert a section break. The problem is that i want to change this page to A3 landscape and remove all headers, which my code currently does not do. How to modify my code below to achieve this?
Below is my current code that insert new page, but keeps the header and a4 portrait:
If wordDrawingExist Then
Selection.EndKey Unit:=wdStory
Selection.InsertFile FileName:=wFile, link:=False
Set wb = Documents.Open(wFile)
Selection.WholeStory
Selection.Copy
Documents(docLogSkjema).Activate
Selection.EndKey Unit:=wdLine
Selection.InsertBreak Type:=wdPageBreak
Selection.Paste
wb.Close False
End If
wFile is fullpath to a wordfile, which is basically a pdf to word from freepdfsolutions.com (Tried inserting the pdf directly but then the quality of the pdf was so bad that numbers were hard to read) and wordDrawingExist is the boolean saying if the wordfile exist or not
OK, first of all, you will need a section break, not a simple page break:
Selection.InsertBreak Type:=wdSectionBreakNextPage
To change to landscape orientation:
Selection.PageSetup.Orientation = wdOrientLandscape
Make sure you are in the section you want to change. Note that after inserting the section break, the cursor will be in the new section.
To change the size to A3, you will need to set the size manually:
With Selection.PageSetup
.PageWidth = CentimetersToPoints(42)
.PageHeight = CentimetersToPoints(29.7)
End With
To delete the header:
selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete
Your selection doesn't include multiple sections, so from the one section it touches, you need the first (duh) hence the Sections(1).
Put it all together:
Selection.InsertBreak Type:=wdSectionBreakNextPage
With Selection.PageSetup
.Orientation = wdOrientLandscape
.PageWidth = CentimetersToPoints(42)
.PageHeight = CentimetersToPoints(29.7)
End With
Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete
This code will insert a new section+page break, set this new section to landscape A3, and remove the headers from it.
Note: You might need to unlink the headers before deleting it:
selection.Sections(1).Headers(wdHeaderFooterPrimary).LinkToPrevious=False
Hope this helps.
Here is the working code in case someone else also find it useful:
'Add drawing
If wordDrawingExist Then
Set wb = Documents.Open(wFile)
Selection.WholeStory
Selection.Copy
Documents(docLogSkjema).Activate
Selection.EndKey Unit:=wdStory
Selection.InsertBreak Type:=wdSectionBreakNextPage
With Selection.PageSetup
.Orientation = wdOrientLandscape
.PageWidth = CentimetersToPoints(42)
.PageHeight = CentimetersToPoints(29.7)
End With
Selection.Sections(1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete
Selection.Sections(1).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
Selection.Sections(1).Footers(wdHeaderFooterPrimary).Range.Delete
Selection.Paste
wb.Close False
End If
I am currently setting up some MS Word templates in Word 2010 and have encountered a problem, where text suddenly disappears at the end of a paragraph.
The problem only occurs in some specific scenarios, but I have experienced that it can be recreated in a lot of different ways. I have not, however, been able to pinpoint the exact reason why this happens. Therefore, I would like to find the specific reason, that makes the issue occur, in order to avoid it.
It seems that a combination of the existence of wrapped tables, content in the page header and a certain length of a line can invoke the issue.
To recreate a document where this issue occurs, please follow this procedure:
Open a new document in Word 2010.
Copy the code below into a new module in the VBA editor.
Run the A_ReplicateScenario macro to insert example content in the document.
Place the cursor at the end of line 3 (the line that ends close to the margin).
Type a new sentence after the dot, beginning with a space.
The text that you have typed, will disappear when the margin is reached.
The text will then be shown if for instance a character is deleted from the original text (i.e. from the beginning of the line) or if a formatting change is made (e.g. clear formatting). The 'Show all' setting in Word can also sometimes display the text, but will only display it while 'Show all' is activated. Other times Word will display 'ghosted' double lines which can not be selected.
A short video of the replicated issue can be viewed here: https://youtu.be/Bqp9STDRkXc
Sub A_ReplicateScenario()
Call SetUpNormalStyle
Call InsertBodyTextLines
Call InsertHeaderTextLines
Call InsertWrappedTables
Call SetUpMargins
Call InsertExampleBodyText
End Sub
Sub SetUpNormalStyle()
With ActiveDocument.Styles("Normal").Font
.Name = "Arial"
.Size = 10
End With
With ActiveDocument.Styles("Normal").ParagraphFormat
.SpaceAfter = 0
.LineSpacingRule = wdLineSpaceAtLeast
.LineSpacing = 12
End With
End Sub
Sub InsertBodyTextLines()
For i = 1 To 4
Selection.TypeParagraph
Next
End Sub
Sub InsertHeaderTextLines()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
For i = 1 To 26
Selection.TypeParagraph
Next
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
Sub InsertWrappedTables()
Selection.HomeKey Unit:=wdStory
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
With Selection.Tables(1).Rows
.WrapAroundText = True
.HorizontalPosition = CentimetersToPoints(2)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.VerticalPosition = CentimetersToPoints(4.5)
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
End With
Selection.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).Columns(1).PreferredWidth = CentimetersToPoints(11)
Selection.MoveDown Unit:=wdLine, Count:=1
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
With Selection.Tables(1).Rows
.WrapAroundText = True
.HorizontalPosition = CentimetersToPoints(10)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.VerticalPosition = CentimetersToPoints(8)
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
End With
Selection.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPoints
Selection.Tables(1).Columns(1).PreferredWidth = CentimetersToPoints(9)
End Sub
Sub SetUpMargins()
With ActiveDocument.PageSetup
.TopMargin = CentimetersToPoints(3.8)
.BottomMargin = CentimetersToPoints(2.8)
.LeftMargin = CentimetersToPoints(2.3)
.RightMargin = CentimetersToPoints(1.5)
End With
End Sub
Sub InsertExampleBodyText()
With Selection
.HomeKey Unit:=wdStory
.MoveDown Unit:=wdLine, Count:=3
.TypeText Text:="Ouwouwouwoiwoiuwoiuwoiuwoiuwoiuwoiuwoiw oiwu oiwu owiu woiu woiuw oiwu owiu owiu ww."
.TypeParagraph
.TypeText Text:="Woiuwoiuwoiuw."
End With
End Sub
The problem is related to the tables being formatted to float around the text. Word has a long history of issues with floating objects. And although Word has improved a lot over the years you might still experience problems, in particular with floating tables.
If you change the formatting of the second table (via Table Properties) and set the text wrapping to None, the bug goes away (YMMV).
My recommendation would be to avoid the floating tables if possible.
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
I want to insert text with custom formatting, then change the font style back to what it was before the code was run.
Dim myText As String
Dim oldFont As Object
'Save old font
Set oldFont = Selection.Font
'Insert text with custom font
myText = "CUSTOM STRING"
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 26
Selection.Font.Bold = True
Selection.TypeText (myText)
'Revert font back to original
Set Selection.Font = oldFont
Can anyone explain a way to do what I'm looking for?
Edit: I should have been more specific. If I am typing text, I have a certain formatting that I am typing in that is shown on the Home Tab (eg. Comic Sans Ms, Size 22, Bold). When I insert text with the code, this changes the formatting that I am typing with, so if I continue typing it will be in the NEW font type, not the Comic Sans MS. I am trying to make it so if I continue typing after I have inserted the text via VBA code, it will retain my old formatting.
One simple solution is to store all properties that you are going to change, and to reset them at the end:
Dim myText As String
Dim oldFont As String
Dim oldSize As Integer
Dim oldBold As Boolean
'Save old font
oldFont = Selection.Font.Name
oldSize = Selection.Font.Size
oldBold = Selection.Font.Bold
'Insert text with custom font
myText = "CUSTOM STRING"
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 26
Selection.Font.Bold = True
Selection.TypeText (myText)
'Revert font back to original
Selection.Font.Name = oldFont
Selection.Font.Bold = oldBold
Selection.Font.Size = oldSize
The trick I find helpful when writing Word macros is simply to replicate what I'd be doing if I was using the Word GUI. When I want to paste formatted text but keep my current format, I type a space, paste in the text before the space then delete the space. As the space has my original format that's how I get it back.
So, doing this as a macro:
'Type a space
Selection.TypeText Text:=" "
'Move Cursor back one character
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'Insert text with custom font
myText = "CUSTOM STRING"
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 26
Selection.Font.Bold = True
Selection.TypeText (myText)
'Move Cursor forward one character
Selection.MoveRight Unit:=wdCharacter, Count:=1
'Delete the space
Selection.TypeBackspace
This will preserve any properties of the text you originally had.
I can't quite figure out exactly what you're trying to do there, but Selection.TypeText will collapse the selection down to the insertion point, so you effectively have no characters selected by the time you try to "revert the font". You either need to re-select the text, or use a Range object instead of the Selection to identify the text to be affected.
The reason that you get an error at the line:
Set Selection.Font = oldFont
...is because - unusually, and perversely - you should not use the Set keyword when assigning to the Font property. Rather than storing a reference to a Font object, the assignment simply applies the properties of the assigned font.
This is very confusing API design, made all the more confusing because you do need to use the Set keyword when reading the Font property, and because that does assign a reference to a Font object!
And that's the other reason why your code won't work - you're taking a reference to a Font object which you then modify, and your reference points to the same Font object that has now changed.
What you actually need to do is create a new Font object to store the original font details, as follows:
Set oldFont = Selection.Font.Duplicate
The Selection.Font object is read only.
This means that there is no way to restore all the settings in one assignment. Since you are only changing a few properties the easiest solution is to save each individual value and restore them afterwards as stephan suggests.
I.e. Save properties:
oldFontName = Selection.Font.Name
oldFontSize = Selection.Font.Size
oldFontBold = Selection.Font.Bold
Do you stuff and then restore properties:
Selection.Font.Name = oldFontName
Selection.Font.Size = oldFontSize
Selection.Font.Bold = oldFontBold
See, if this piece of code gives you enough hint.
CopyFormat picks up the existing formatting by moving left from current cursor.
PasteFormat applies it to a character & from there on, the original formatting (which was copied) comes into effect.
Selection.MoveLeft unit:=wdWord, Count:=1
Selection.EndKey Extend:=wdExtend
Selection.CopyFormat
Selection.MoveRight unit:=wdWord
'* New text and new formatting
Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.Font.Size = 28
Selection.TypeText "hello world"
Selection.TypeText " "
Selection.MoveLeft unit:=wdCharacter, Count:=1
Selection.EndKey Extend:=wdExtend
Selection.PasteFormat
Selection.TypeText "original formatting here"
Sub No_Format()
'
' No_Format Macro
'
'
Selection.PasteSpecial Link:=False, DataType:=wdPasteText
End Sub
this will allow you to paste the text and adopting the new formatting.