I try to run the following code:
Sub Para()
Dim objParagraph As paragraph
Set objParagraph = ActiveDocument.Paragraphs(1)
objParagraph.Alignment = wdParagraphAlignment.wdAlignParagraphLeft
End Sub
But the compiler gives me back that the custom type is not defined. How is that so? I found this code here: https://bettersolutions.com/word/paragraphs/vba-code.htm
You don't need 'wdParagraphAlignment.'
Sub Para()
Dim objParagraph As Paragraph
Set objParagraph = ActiveDocument.Paragraphs(1)
objParagraph.Alignment = wdAlignParagraphLeft
End Sub
Related
Below code is trying to convert words in lowercase in to uppercase. However I only need to run it only in a specific word style ("Normal"). I tried to set doc to ActiveDocument.Styles("Normal") but i keep on getting error. Any help would be most helpful. Thank you in advance.
Option Explicit
Public Sub TitleCaseDocument()
Dim doc As Document: Set doc = ActiveDocument.Styles("Normal")
Dim wrd As Range
For Each wrd In doc.Words
If wrd.Text <> UCase$(wrd.Text) Then wrd.Case = wdTitleWord
Next
End Sub
The solution provided by #eaazel falls into the default member trap.
The code
wrd.Style
is in reality using the default member of the style object, which is 'NameLocal'. Thus the code implied by the code above is in reality
wrd.Style.NameLocal
Normally this would not be a problem, however, the level of granularity that is being used to extract the style object means that, on occasion, words with no style will be encountered (e.g. a ToC field). In such a case the style object returned is nothing and this generates a surprising error because you cannot call the NameLocal method on an an object that is nothing.
Therefore a more correct approach is to use a word unit that is guaranteed to have a style object (e.g. paragraphs) and to test for the style on this object before testing each word.
Option Explicit
Public Sub TitleCaseDocument()
Dim myDoc As Document: Set myDoc = ActiveDocument
Dim myPara As Range
For Each myPara In myDoc.StoryRanges.Item(wdMainTextStory).Paragraphs
If myPara.Style.NameLocal = "Normal" Then
TitleParagraph myPara
End If
Next
End Sub
Public Sub TitleParagraph(ByVal ipRange As Word.Range)
Dim myText As Range
For Each myText In ipRange.Words
If Not UCase$(myText.Text) = myText.Text Then
myText.Words.Item(1).Case = wdTitleWord
End If
Next
End Sub
Update 2020-Apr-16 Revised code below which has been proved to work on a Word document.
Option Explicit
Public Sub TitleCaseDocument()
Dim myDoc As Document: Set myDoc = ActiveDocument
Dim myPara As Word.Paragraph
For Each myPara In myDoc.StoryRanges.Item(wdMainTextStory).Paragraphs
If myPara.Style.NameLocal = "Normal" Then
TitleParagraph myPara
End If
Next
End Sub
Public Sub TitleParagraph(ByVal ipPara As Word.Paragraph)
Dim myText As Range
For Each myText In ipPara.Range.Words
If Not UCase$(myText.Text) = myText.Text Then
myText.Words.Item(1).Case = wdTitleWord
End If
Next
End Sub
So Do You want to change lowercase in to uppercase if style is normal?
Yes?
I don't have big experience with word but maybe something like this help you (base on your code):
Public Sub TitleCaseDocument()
Dim doc As Document: Set doc = ActiveDocument
Dim wrd As Range
For Each wrd In doc.Words
If wrd.Text <> UCase$(wrd.Text) And wrd.Style = "Normal" Then
wrd.Text = UCase$(wrd.Text)
End If
Next
End Sub
I'm attempting to read through a Word Document (800+ pages) line by line, and if that line contains certain text, in this case Section, simply print that line to console.
Public Sub doIt()
SearchFile("theFilePath", "Section")
Console.WriteLine("SHit")
End Sub
Public Sub SearchFile(ByVal strFilePath As String, ByVal strSearchTerm As String)
Dim sr As StreamReader = New StreamReader(strFilePath)
Dim strLine As String = String.Empty
For Each line As String In sr.ReadLine
If line.Contains(strSearchTerm) = True Then
Console.WriteLine(line)
End If
Next
End Sub
It runs, but it doesn't print out anything. I know the word "Section" is in there multiple times as well.
As already mentioned in the comments, you can't search a Word document the way you are currently doing. You need to create a Word.Application object as mentioned and then load the document so you can search it.
Here is a short example I wrote for you. Please note, you need to add reference to Microsoft.Office.Interop.Word and then you need to add the import statement to your class. For example Imports Microsoft.Office.Interop. Also this grabs each paragraph and then uses the range to look for the word you are searching for, if found it adds it to the list.
Note: Tried and tested - I had this in a button event, but put where you need it.
Try
Dim objWordApp As Word.Application = Nothing
Dim objDoc As Word.Document = Nothing
Dim TextToFind As String = YOURTEXT
Dim TextRange As Word.Range = Nothing
Dim StringLines As New List(Of String)
objWordApp = CreateObject("Word.Application")
If objWordApp IsNot Nothing Then
objWordApp.Visible = False
objDoc = objWordApp.Documents.Open(FileName, )
End If
If objDoc IsNot Nothing Then
'loop through each paragraph in the document and get the range
For Each p As Word.Paragraph In objDoc.Paragraphs
TextRange = p.Range
TextRange.Find.ClearFormatting()
If TextRange.Find.Execute(TextToFind, ) Then
StringLines.Add(p.Range.Text)
End If
Next
If StringLines.Count > 0 Then
MessageBox.Show(String.Join(Environment.NewLine, StringLines.ToArray()))
End If
objDoc.Close()
objWordApp.Quit()
End If
Catch ex As Exception
'publish your exception?
End Try
Update to use Sentences - this will go through each paragraph and grab each sentence, then we can see if the word exists... The benefit of this is it's quicker because we get each paragraph and then search the sentences. We have to get the paragraph in order to get the sentences...
Try
Dim objWordApp As Word.Application = Nothing
Dim objDoc As Word.Document = Nothing
Dim TextToFind As String = "YOUR TEXT TO FIND"
Dim TextRange As Word.Range = Nothing
Dim StringLines As New List(Of String)
Dim SentenceCount As Integer = 0
objWordApp = CreateObject("Word.Application")
If objWordApp IsNot Nothing Then
objWordApp.Visible = False
objDoc = objWordApp.Documents.Open(FileName, )
End If
If objDoc IsNot Nothing Then
For Each p As Word.Paragraph In objDoc.Paragraphs
TextRange = p.Range
TextRange.Find.ClearFormatting()
SentenceCount = TextRange.Sentences.Count
If SentenceCount > 0 Then
Do Until SentenceCount = 0
Dim sentence As String = TextRange.Sentences.Item(SentenceCount).Text
If sentence.Contains(TextToFind) Then
StringLines.Add(sentence.Trim())
End If
SentenceCount -= 1
Loop
End If
Next
If StringLines.Count > 0 Then
MessageBox.Show(String.Join(Environment.NewLine, StringLines.ToArray()))
End If
objDoc.Close()
objWordApp.Quit()
End If
Catch ex As Exception
'publish your exception?
End Try
Here's a sub that will print each line that the search-string is found on, rather than each paragraph. It will mimic the behavior of using the streamreader in your example to read/check each line:
'Add reference to and import Microsoft.Office.Interop.Word
Public Sub SearchFile(ByVal strFilePath As String, ByVal strSearchTerm As String)
Dim wordObject As Word.Application = New Word.Application
wordObject.Visible = False
Dim objWord As Word.Document = wordObject.Documents.Open(strFilePath)
objWord.Characters(1).Select()
Dim bolEOF As Boolean = False
Do Until bolEOF
wordObject.Selection.MoveEnd(WdUnits.wdLine, 1)
If wordObject.Selection.Text.ToUpper.Contains(strSearchTerm.ToUpper) Then
Console.WriteLine(wordObject.Selection.Text.Replace(vbCr, "").Replace(vbCr, "").Replace(vbCrLf, ""))
End If
wordObject.Selection.Collapse(WdCollapseDirection.wdCollapseEnd)
If wordObject.Selection.Bookmarks.Exists("\EndOfDoc") Then
bolEOF = True
End If
Loop
objWord.Close()
wordObject.Quit()
objWord = Nothing
wordObject = Nothing
Me.Close()
End Sub
It is a slightly modified vb.net implementation of nawfal's solution to parsing word document lines
I need to run a PowerPoint sub from R via:
shell(shQuote(normalizePath("C:/.../VBA_Script.vbs"))).
The script VBA_Script should trigger a sub called request_bank, which should open amsgboxwith the value of the variablebank(=J. P. Morgan`).
I get the error:
Application.Run: Invalid request. Sub or function not defined, Code: 80048240, MS PowerPoint 2013.
I just tried all the different Run.-Paths mentioned in this thread Run PowerPoint Sub from Excel. I still get the error. I wonder why the same code is working if I run the same Sub in Excel or if I add the rows:
Dim PSlide
Set PSlide = PPres.Slides(1).Duplicate
But that's no clean solution for me. There must be a better way.
VBS-Script:
Option Explicit
CallPMacro
Sub CallPMacro()
Dim PApp
Dim PPres
'Dim PSlide
Set PApp = CreateObject("PowerPoint.Application")
Set PPres = PApp.Presentations.Open("C:\...\test.pptm", 0, True)
'Set PSlide = PPres.Slides(1).Duplicate
PApp.Visible = True
PApp.Run "request_bank"
PApp.Quit
Set PPres = Nothing
Set PApp = Nothing
End Sub
VBA-Code from the Sub request_bank in the test.pptm:
Sub request_bank()
Dim bank As String
bank = "J.P. Morgan"
MsgBox ("bank: " & bank)
End Sub
Any idea how to fix it?
I am creating a macro for CorelDraw which will import a file from a given folder when a button called Generate is pressed. When trying to assign a filepath to a variable, I get the following error:
Object Required
Here's my code:
Private Sub UserForm_Initialize()
'Design Of Item'
Me.DesignList.AddItem ("BIFT")
Me.DesignList.AddItem ("BIFC1")
Me.DesignList.AddItem ("BIFC2")
Me.DesignList.AddItem ("BIFI")
'Type Of Item'
Me.TypeList.AddItem ("BIF HOODIE")
Me.TypeList.AddItem ("BIF T-SHIRT")
Me.TypeList.AddItem ("BIF SWEAT")
Me.TypeList.AddItem ("BIF TANK")
'Colours of the items'
Me.ColourList.AddItem ("Grey")
Me.ColourList.AddItem ("White")
Me.ColourList.AddItem ("Black")
Me.ColourList.AddItem ("Navy")
Dim Design As String
Dim Ctype As String
Dim Colour As String
Dim ShirtFPath As String
End Sub
Private Sub GenerateBtn_Click()
Set ShirtFPath = ("C:\Users\Matt\Pictures\Clothing Line\Shirts")
MsgBox (ShirtFPath)
Set Design = DesignList.Value
Set Ctype = TypeList.Value
Set Colour = ColourList.Value
End Sub
Private Sub SaveBtn_Click()
Dim fPath As Object
Dim sr As ShapeRange
Set fPath = Me.TB.Value
If fPath Is Nothing Then Exit Sub
End Sub
You only use Set for object assignment. For intrinsic types (numbers, strings, booleans), omit the word Set:
ShirtFPath = "C:\Users\Matt\Pictures\Clothing Line\Shirts"
Design = DesignList.Value
Ctype = TypeList.Value
Colour = ColourList.Value
I have a problem very similar to this
However the answer there is not very clear, and I tried recreating the commandbutton in question, and it did not work.
Basically I have various sections within the template and for each section I have two buttons
[Add sub-section] - (CommandButton1, CommandButton11, CommandButton111)
[Done] - (CommandButton2, CommandButton21, CommandButton211)
Everything works fine in the template.
But if I create a new doc by either double clicking on the dotm or right clicking->new and then try using the buttons, they all run well, until I try one of the [Done] buttons. At the first attempt it works, post which no code works what so ever. Here's the code
Private Sub CommandButton1_Click()
Dim objTemplate As Template
Dim objBB As BuildingBlock
' Set the template to store the building block
Set objTemplate = ActiveDocument.AttachedTemplate
' Access the building block through the type and category
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom5) _
.Categories("General").BuildingBlocks("Experience")
' Insert the building block into the document replacing any selected text.
Selection.MoveUp Unit:=wdLine, Count:=1
objBB.Insert Selection.Range
End Sub
Private Sub CommandButton11_Click()
Dim objTemplate As Template
Dim objBB As BuildingBlock
' Set the template to store the building block
Set objTemplate = ActiveDocument.AttachedTemplate
' Access the building block through the type and category
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom5) _
.Categories("General").BuildingBlocks("Experience")
' Insert the building block into the document replacing any selected text.
Selection.MoveUp Unit:=wdLine, Count:=1
objBB.Insert Selection.Range
End Sub
Private Sub CommandButton111_Click()
Dim objTemplate As Template
Dim objBB As BuildingBlock
' Set the template to store the building block
Set objTemplate = ActiveDocument.AttachedTemplate
' Access the building block through the type and category
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom5) _
.Categories("General").BuildingBlocks("Education")
' Insert the building block into the document replacing any selected text.
Selection.MoveUp Unit:=wdLine, Count:=1
objBB.Insert Selection.Range
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
Err.Clear
Dim i As Integer
i = ActiveDocument.InlineShapes.Count
Do While (i > 0)
If ActiveDocument.InlineShapes(i).OLEFormat.ClassType = "Forms.CommandButton.1" Then
If ActiveDocument.InlineShapes(i).OLEFormat.Object.Name = "CommandButton1" _
Or ActiveDocument.InlineShapes(i).OLEFormat.Object.Name = "CommandButton2" Then
If Err.Number = 0 Then
ActiveDocument.InlineShapes(i).Delete
End If
Err.Clear
End If
End If
i = i - 1
Loop
End Sub
Private Sub CommandButton21_Click()
On Error Resume Next
Err.Clear
Dim i As Integer
i = ActiveDocument.InlineShapes.Count
Do While (i > 0)
If ActiveDocument.InlineShapes(i).OLEFormat.ClassType = "Forms.CommandButton.1" Then
If ActiveDocument.InlineShapes(i).OLEFormat.Object.Name = "CommandButton11" _
Or ActiveDocument.InlineShapes(i).OLEFormat.Object.Name = "CommandButton21" Then
If Err.Number = 0 Then
ActiveDocument.InlineShapes(i).Delete
End If
Err.Clear
End If
End If
i = i - 1
Loop
End Sub
Private Sub CommandButton211_Click()
On Error Resume Next
Err.Clear
Dim i As Integer
i = ActiveDocument.InlineShapes.Count
Do While (i > 0)
If ActiveDocument.InlineShapes(i).OLEFormat.ClassType = "Forms.CommandButton.1" Then
If ActiveDocument.InlineShapes(i).OLEFormat.Object.Name = "CommandButton111" _
Or ActiveDocument.InlineShapes(i).OLEFormat.Object.Name = "CommandButton211" Then
If Err.Number = 0 Then
ActiveDocument.InlineShapes(i).Delete
End If
Err.Clear
End If
End If
i = i - 1
Loop
I'm new to VBA and built this by putting together various snippets from various sources ( I know it may not be all that neat, but had to start somewhere). The [Done] code (commandbutton2,21,211) came from this question I had asked earlier, just to give you some context.
In the editor I have three projects
Normal
Microsoft Word Objects
ThisDocument - [Empty]
Document1
Microsoft Word Objects
ThisDocument - [Empty]
References
Reference to Template Project
Template
Microsoft Word Objects
ThisDocument - [Got all the code]
I tried manually copying all of the code in "template" project into the "document1" project and then saving it as a docm. This fixed the problem, however I can't settle for this as [Add sub-section] basically adds a building block stored in the original template(which wont be available if I were to mail the docm to someone).
I'm open to any solution as long as at the end of it I have a file that can be mailed to someone and they could add sections at the click of a button
When using On Error Resume Next to manage an anticipated problem it's best to limit its scope as much as possible, or you run the risk of masking other errors in your code.
For example, you can remove it from your posted code by creating an "IsButton()" function something like this:
Function Isbutton(s) As Boolean
Dim f As String
On Error Resume Next
f = s.OLEFormat.ClassType
On Error GoTo 0
Isbutton = (f = "Forms.CommandButton.1")
End Function
Factoring out the repeated code it reduces to something like this:
Private Sub CommandButton1_Click()
InsertSection
End Sub
Private Sub CommandButton11_Click()
InsertSection
End Sub
Private Sub CommandButton111_Click()
InsertSection
End Sub
Sub InsertSection()
Dim objTemplate As Template
Dim objBB As BuildingBlock
Set objTemplate = ActiveDocument.AttachedTemplate
Set objBB = objTemplate.BuildingBlockTypes(wdTypeCustom5) _
.Categories("General").BuildingBlocks("Experience")
Selection.MoveUp Unit:=wdLine, Count:=1
objBB.Insert Selection.Range
End Sub
Private Sub CommandButton2_Click()
DeleteButtons "CommandButton1", "CommandButton2"
End Sub
Private Sub CommandButton21_Click()
DeleteButtons "CommandButton11", "CommandButton21"
End Sub
Private Sub CommandButton211_Click()
DeleteButtons "CommandButton111", "CommandButton211"
End Sub
Private Sub DeleteButtons(Name1 As String, Name2 As String)
Dim i As Integer, s As InlineShape, nm As String
i = ActiveDocument.InlineShapes.Count
Do While (i > 0)
Set s = ActiveDocument.InlineShapes(i)
If Isbutton(s) Then
nm = s.OLEFormat.Object.Name
Debug.Print i, nm '<<<EDIT
If nm = Name1 Or nm = Name2 Then s.Delete
End If
i = i - 1
Loop
End Sub