In word, I have been creating a macro that formats an existing table. The dimension of the table can be anything. The formatting looks like this:
My VBA code in word looks like this:
Sub Makro7()
'
' Makro7 Makro
'
'
Selection.HomeKey Unit:=wdRow
Selection.HomeKey Unit:=wdColumn
Selection.Range.Relocate wdRelocateDown
Selection.Range.Relocate wdRelocateUp
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = 192
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.EndKey Unit:=wdColumn, Extend:=True
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
.CollapsedByDefault = False
End With
End Sub
Now, I need this function in Powerpoint too. Unfortunately I can't just copy this code to Powerpoint. I'm not that familiar with VBA in Powerpoint, and don't know how to proceed. I get an error if I use this code within Powerpoint.
Related
I am doing a document using a userform. In the userform I setup radiobuttons when clicked I want the text from a macro that I did to be inserted at a specific bookmark in my document. Help please
This is my macro:
Sub ordonnance()
'
' ORDONNANCE Macro
'
'
Dim bmSignet As Bookmark
Dim rgPlageDuSignet As Range
Set bmSignet = ActiveDocument.Bookmarks("ORDONNANCE_DE")
Set rgPlageDuSignet = bmSignet.Range
rgPlageDuSignet.Select
ActiveDocument.Tables.Add rgPlageDuSignet, 1, 1
With Selection.Tables(1)
If .Style <> "Grille du tableau" Then
.Style = "Grille du tableau"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.Font.Name = "Arial"
Selection.Font.Size = 12
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="ORDONNANCE DE NON-PUBLICATION ..."
Set bmSignet = Nothing
Set rgPlageDuSignet = Nothing
End Sub
This is my radiobutton:
Private Sub OptionButton3_Click()
If Me.OptionButton3.Value = True Then
Call RemplaceSignet("ORDONNANCE_DE", "ORDONNANCE DE NON-PUBLICATION ...")
Else
Call RemplaceSignet("ORDONNANCE_DE", " ")
End If
End Sub
Try:
Sub ordonnance(StrBkMk As String, StrTxt As String)
'
' ORDONNANCE Macro
'
'
Dim Tbl As Table
With ActiveDocument
Set Tbl = .Tables.Add(.Bookmarks(StrBkMk).Range, 1, 1)
With Tbl
.Style = "Grille du tableau"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
With .Cell(1, 1).Range
With .Font
.Name = "Arial"
.Size = 12
.Bold = True
End With
.Text = StrTxt
End With
End With
End With
Set Tbl = Nothing
End Sub
Note that there is no need to select anything.
I am trying to format selected text in Outlook 2010.
I recorded a macro that works for Word.
My Outlook code fails on the second line before I get to the working Word code.
I have been using VBA for many years, almost entirely in Excel.
Option Explicit
Public Sub UseWord_Fmt()
' Wrapper
Dim Ins As Outlook.Inspector
Dim wDoc As Word.Document
Dim Word As Word.Application
Dim Selection As Word.Selection
Set Ins = Application.ActiveInspector
Set wDoc = Ins.WordEditor
Set Word = wDoc.Application
Set Selection = Word.Selection
'
'
' My code, generic so that I can later modify
'
'
Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdLine, Count:=4, Extend:=wdExtend
With Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 6
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With
End Sub
Outlook does not understand InchesToPoints(0) When Converting a measurement from inches to points- simply use .LeftIndent = (0), or specify the Application Example Word.InchesToPoints(0)
Public Sub UseWord_Fmt()
' Wrapper
Dim Ins As Outlook.Inspector
Dim wDoc As Word.Document
Dim Word As Word.Application
Dim Selection As Word.Selection
Set Ins = Application.ActiveInspector
Set wDoc = Ins.WordEditor
Set Word = wDoc.Application
Set Selection = Word.Selection
'
'
' My code, generic so that I can later modify
'
'
Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdLine, Count:=4, Extend:=wdExtend
With Selection.ParagraphFormat
.LeftIndent = (0)
.RightIndent = (0)
.SpaceBefore = 6
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.pageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = (0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With
End Sub
I am programmatically changing some styles and adding multilevel numbering to achieve a "Title, Sub Title... etc." structure. Everything works, the style are right, the numbering works through the levels.
When the styles are used just on their own they line up fine to where I want them but when the numbering code is used a 1.52cm indent is put in from somewhere and is overriding the indent code of the Style.
The style code is run after the numbering code and so should overwrite any defaults that I missing.
My code is below if anyone can give me a hand.
Private Sub doSReport()
Dim application As Word.Application = Globals.ThisAddIn.Application
Dim numberlist = application.ListGalleries(WdListGalleryType.wdOutlineNumberGallery).ListTemplates(1)
With numberlist
.Name = ""
With .ListLevels(1)
.NumberFormat = "%1."
.NumberStyle = WdListNumberStyle.wdListNumberStyleArabic
.NumberPosition = 0
.TextPosition = 21
.TabPosition = 21
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = "Heading 1"
End With
With .ListLevels(2)
.NumberFormat = "%1.%2."
.NumberStyle = WdListNumberStyle.wdListNumberStyleArabic
.NumberPosition = 0
.TextPosition = 29
.TabPosition = 29
.ResetOnHigher = 1
.StartAt = 1
.LinkedStyle = "Heading 2"
End With
With .ListLevels(3)
.NumberFormat = "%1.%2.%3"
.NumberStyle = WdListNumberStyle.wdListNumberStyleArabic
.NumberPosition = 0
.TextPosition = 36
.TabPosition = 36
.ResetOnHigher = 2
.StartAt = 1
.LinkedStyle = "Heading 3"
End With
End With
With Doc.Styles(Word.WdBuiltinStyle.wdStyleHeading1)
.NameLocal = "Chapter Title"
.Font.Bold = True
.Font.Size = 16
.Font.Name = "Calibri"
.Font.Color = WdColor.wdColorDarkYellow 'RGB(36, 95, 144)
.LinkStyle = True
.QuickStyle = True
.Visibility = False
.Priority = 3
.ParagraphFormat.LeftIndent = 0
.ParagraphFormat.FirstLineIndent = 21.54
.ParagraphFormat.SpaceBefore = 12
.ParagraphFormat.SpaceAfter = 6
.ParagraphFormat.PageBreakBefore = True
.LinkToListTemplate(numberlist, 1)
End With
With Doc.Styles(Word.WdBuiltinStyle.wdStyleHeading2)
.NameLocal = "Chapter Subheading"
.Font.Bold = True
.Font.Size = 11
.Font.Name = "Calibri"
.Font.Color = RGB(36, 95, 144)
.LinkStyle = True
.QuickStyle = True
.Visibility = False
.Priority = 4
.ParagraphFormat.LeftIndent = 0
.ParagraphFormat.FirstLineIndent = -29
.LinkToListTemplate(numberlist, 2)
End With
With Doc.Styles(Word.WdBuiltinStyle.wdStyleHeading3)
.Font.Bold = True
.Font.Italic = True
.Font.Size = 11
.Font.Name = "Calibri"
.Font.Color = RGB(36, 95, 144)
.LinkStyle = True
.QuickStyle = True
.Visibility = False
.Priority = 5
.ParagraphFormat.LeftIndent = 0
.ParagraphFormat.FirstLineIndent = -36
.LinkToListTemplate(numberlist, 3)
End With
Numbering style indenting overrides paragaph style indenting - always, no matter in what order it's applied. So you need to work with the indenting specified in the ListTemplate.
As in the dialog box for setting up numbering, there are three settings that determine where the number and text are positioned: NumberPosition, TabPosition and TextPosition. You can read more in the object model Help and compare to the settings in the dialog box.
Keep in mind that Word calculates these (and many, many other) settings in Points. We, of course, think in centimeters (or inches). Word makes it easy for us by providing conversion functions such as CentimetersToPoint (and the reverse, as well as InchesToPoints and the reverse). Note that these can only be used when the project has a reference to the Word COM library ("early-binding").
Sub ListTemplatePlusHeadingIndents()
Dim doc As word.Document = ActiveDocument
Dim lt As word.ListTemplate = doc.ListTemplates.Add(True, "LT_Test")
Dim sH1 As word.style = doc.styles(wdStyleHeading1)
Dim sH2 As word.style= doc.styles(wdStyleHeading2)
Dim indentLvlBase as Double = 0
Dim indentLvl1 as Double = Word.CentimetersToPoints(0.7)
Dim indentLvl2 as Double = 2 * indentLvl1
With lt.ListLevels(1)
.LinkedStyle = sH1
.NumberPosition = indentLvlBase
.TabPosition = indentLvl1
.TextPosition = indentLvl1
End With
With lt.ListLevels(2)
.LinkedStyle = sH2
.NumberPosition = indentLvl1
.TabPosition = indentLvl2
.TextPosition = indentLvl2
End With
End Sub
So I have a set of code that would select a specific range of text to be hidden and I need to have a macro that would select those hidden text and unhide them. However, I don't know how to select those hidden text without first displaying them. Is there a way to select hidden text while they're not displayed. I'm trying to create a dynamic template where if certain conditions are selected only certain text will appear. So far this is my code to unhide hidden text.
Sub Macro2()
'
' Macro2 Macro
'
'
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdParagraph, Count:=4, Extend:=wdExtend
With Selection.Font
.NameFarEast = "+Body Asian"
.NameAscii = "+Body"
.NameOther = "+Body"
.Name = "+Body"
.Size = 11
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
.Ligatures = wdLigaturesNone
.NumberSpacing = wdNumberSpacingDefault
.NumberForm = wdNumberFormDefault
.StylisticSet = wdStylisticSetDefault
.ContextualAlternates = 0
End With
End Sub
The hidden text has to be visible on the screen to be selected. So you need this in your code. You don't need to un-hide them;
ActiveDocument.ActiveWindow.View.ShowHiddenText = True
If you want the user to not see the texts while running this may do the job. However, it is not tested;
Application.ScreenUpdating = False
Remember to turn it back on at the end of your code;
Application.ScreenUpdating = True
We have a macro we run to format the page for our publisher. There are several documents that use this macro. For smaller documents the macro runs without error, for larger documents we receive the error in the subject line of this thread.
Small document - <= 256KB
Large document - >= 500KB
For the documents that have the error I can open them in Word and manually make the settings without a problem.
Here is the second version of the macro
Function pagestuffB() As String
'
' Format for Publisher
'
'
Dim rv As String
rv = ""
On Error GoTo ErrorHndlr:
With Application
.Options.Pagination = False
.ScreenUpdating = False
With .ActiveDocument.PageSetup
.PaperSize = wdPaperLetter
' .PageWidth = InchesToPoints(8.5)
' .PageHeight = InchesToPoints(11)
.Orientation = wdOrientPortrait
.MirrorMargins = True 'ERROR HERE
.TopMargin = InchesToPoints(1.34)
.HeaderDistance = InchesToPoints(0.98)
.BottomMargin = InchesToPoints(1)
.FooterDistance = InchesToPoints(0.8)
.LeftMargin = InchesToPoints(1.61)
.RightMargin = InchesToPoints(1.4)
.Gutter = InchesToPoints(0)
.SectionStart = wdSectionContinuous
.OddAndEvenPagesHeaderFooter = True
.DifferentFirstPageHeaderFooter = True
.LineNumbering.Active = False
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
End With
pagestuffB = rv
Exit Function
ErrorHndlr:
If rv = "" Then
rv = "Macro error " & Err.Number
Select Case Err.Number
Case Else
End Select
End If
Resume Next
End Function
Version info: Word 2010, VS 2012.
I have the document that failed and will provide it if needed.
EDIT: The documents are here
This is the latest version of the macro, which actually runs, but.... It took .5 hours to format the two documents, two of the smallest, in the link above.
Function pagestuffB() As String
'
' Format for Publisher
'
'
Dim rv As String
rv = ""
On Error GoTo ErrorHndlr:
With Application
.Options.Pagination = False
.ScreenUpdating = False
.WindowState = wdWindowStateMinimize
End With
Dim oSec As Section
For Each oSec In Selection.Sections
With oSec.PageSetup
.Orientation = wdOrientPortrait 'moved per macropod
.PaperSize = wdPaperLetter
.MirrorMargins = True
.TopMargin = InchesToPoints(1.34)
.HeaderDistance = InchesToPoints(0.98)
.BottomMargin = InchesToPoints(1)
.FooterDistance = InchesToPoints(0.8)
.LeftMargin = InchesToPoints(1.61)
.RightMargin = InchesToPoints(1.4)
.Gutter = InchesToPoints(0)
.SectionStart = wdSectionContinuous
.OddAndEvenPagesHeaderFooter = True
.DifferentFirstPageHeaderFooter = True
.LineNumbering.Active = False
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
Next oSec
pagestuffB = rv
Exit Function
ErrorHndlr:
If rv = "" Then
rv = "Macro error " & Err.Number
Select Case Err.Number
Case Else
End Select
End If
Resume Next
End Function
So I removed these three lines of code and the macro worked very quickly on my computer for those two documents. It seems like you used a recorded macro to build this code. It's certainly hard to grasp what exactly you want this code to do since there are no comments describing what your code does :). Comment underneath if this suggestion does not fix your problem.
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1