Good Day all. I'm far from a programmer however i need assistance finding out the error with this VBA script. It is run in a word document for repair order form. Its purpose is to increase the order number by one for each print. The counter updates a .txt file To identify the next number needed to print. That as far as my understanding goes. The code is below.
Sub serialNumberPrint()
'
' SerialNumber Macro
'
'
Dim Message As String, Title As String, Default As String, NumCopies As Long
Dim Rng1 As Range
' Set prompt.
Message = "Enter the number of copies that you want to print"
' Set title.
Title = "Print"
' Set default.
Default = "1"
' Display message, title, and default value.
NumCopies = Val(InputBox(Message, Title, Default))
SerialNumber = System.PrivateProfileString("C:\Users\GaleR\Documents\SettingsSerial.Txt", _
"MacroSettings", "SerialNumber")
If SerialNumber = "" Then
SerialNumber = 1
End If
Set Rng1 = ActiveDocument.Bookmarks("SerialNumber").Range
Counter = 0
While Counter < NumCopies
Rng1.Delete
Rng1.Text = Format(SerialNumber, "000#")
ActiveDocument.PrintOut
SerialNumber = SerialNumber + 1
Counter = Counter + 1
Wend
'Save the next number back to the Settings.txt file ready for the next use.
System.PrivateProfileString("C:\Users\GaleR\Documents\SettingsSerial.txt", "MacroSettings", _
"SerialNumber") = SerialNumber
'Recreate the bookmark ready for the next use.
With ActiveDocument.Bookmarks
.Add Name:="SerialNumber", Range:=Rng1
End With
ActiveDocument.Save
End Sub
The debug brings me to this line:
Set Rng1 = ActiveDocument.Bookmarks("SerialNumber").Range
I am at wits end and am not sure how to proceed. I apologize beforehand for my lack of knowledge but really do need the assistance.
The error is telling you that the bookmark SerialNumber does not exist in the document. If you select the place in the document (or template) and insert a bookmark with that name it should solve the problem.
Related
I've been dealing with this a while and even had help but i can't work it out.
The following macro renames PartName or InstanceName depending on user and CADSelection.
Problem is it's not working in PartName alteration.
Can someone help me complete this macro? and ideally explain what i did incorrectly?
Sub CATMain()
If CATIA.Documents.Count = 0 Then
MsgBox "There are no CATIA documents open. Please open a CATIA document and try again.", ,msgboxtext
Exit Sub
End If
If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then
MsgBox "The active document is not a Product. Please open a CATIA Product and try again.", ,msgboxtext
Exit Sub
End If
Dim oSelection As Selection
Set oSelection = CATIA.ActiveDocument.Selection
If oSelection.Count < 1 then
MsgBox "Pick some components using cad selection."
Else
'****** Alter Instance Name *****'
Dim msg
msg = MsgBox ("Click ""Yes"" to change Instance Name, ""No"" to change Part Name or ""Cancel"" to exit", _
vbYesNoCancel, "Renaming Tool")
if vbYes = msg then
'****** Inputbox for Instance name alteration *****
Dim NewIName As String
NewIName = InputBox("Please input the desired Instance Name. Example: E","Instance name alteration","E")
'****** Inputbox for Instance number alteration *****
Dim NewINumber As Integer
NewINumber = InputBox("Please input the initial number for the 1st component. Example: 1","Instance numbering alteration","1")
Dim oIBody
Dim InstName As Body
For oIBody = 1 to oSelection.Count
Set InstName = oSelection.Item(oIBody).Value
'****** Instance name alteration *****
InstName.Parent.Parent.ReferenceProduct.Products.Item( _
InstName.Name).Name= NewIName + CStr(NewINumber)
NewINumber=NewINumber+1
Next
elseif vbNo = msg then
'****** Inputbox for Part name alteration *****
Dim NewPName As String
NewPName = InputBox("Please input the desired Part Name. Example: E","Part Name alteration","E")
'****** Inputbox for Part number alteration *****
Dim NewPNumber As Integer
NewPNumber = InputBox("Please input the initial number for the 1st Component. Example: 1","Part numbering alteration","1")
Dim oPBody
Dim PartName As Body
For oPBody = 1 to oSelection.Count
Set PartName = oSelection.Item(oPBody).Value
'****** Part name alteration *****
PartName.ReferenceProduct.Name= NewPName + CStr(NewPNumber)
NewPNumber=NewPNumber+1
Next
End If
End If
oSelection.Clear
End Sub
The part "name" is really the Part Number and is changed using the "PartNumber" property.
So try changing
PartName.ReferenceProduct.Name= NewPName + CStr(NewPNumber)
to
PartName.ReferenceProduct.PartNumber= NewPName + CStr(NewPNumber)
This doesn't influence the document name unless you have not saved your part already.
What else :
1) Your variable naming is confusing. You call the Product "InstName" in one place and "PartName" in another. At first glance I thought those were strings. Using oProduct would be less confusing.
2) You seem real confident that the user has pre-selected the correct types. Since you are selecting in an assembly, instead of using Selection.Item(i).Value, you can use Selection.item(i).LeafProduct which will always be the instance product of whatever object is selected. Even if the user picks a surface, it will return the instance product which contains the selected surface.
I have some word documents with unaccepted, tracked changes. I want to accept them but still have them shown in red in my documents. I think a good way to do this would be doing a wildcard search for unaccepted changes and replacing them with the same text in red, however I dont know if this is possible.
I am also happy with other ways of achieving my goal, without wildcards.
Applying formatting to revisions cannot be done using Word's standard find & replace operation. However, you can write a macro that enumerates all revisions and then applies formatting to each of them.
There is a bloc post by Chris Rae who provides a macro that converts revisions to standard formatting:
Enumerating edits on large documents (AKA converting tracked changes to conventional formatting)
The macro may not yet do exactly what you need, but it should get you started.
For reference, here is a copy of the macro:
Sub EnumerateChanges()
Dim rAll As Revision
Dim dReport As Document
Dim dBigDoc As Document
Set dBigDoc = ActiveDocument
If dBigDoc.Revisions.Count = 0 Then
MsgBox "There are no revisions in the active document.", vbCritical
ElseIf MsgBox(“This will enumerate the changes in '" + dBigDoc.Name + "' in a new document and close the original WITHOUT saving changes. Continue?", vbYesNo) <> vbNo Then
Set dReport = Documents.Add
dBigDoc.Activate ' really just so we can show progress by selecting the revisions
dBigDoc.TrackRevisions = False ' Leaving this on results in a disaster
For Each rAll In dBigDoc.Revisions
' Now find the nearest section heading downwards
Dim rFindFirst As Range, rFindLast As Range
Set rFindLast = rAll.Range.Paragraphs(1).Range
While Not IsNumberedPara(rFindLast.Next(wdParagraph))
Set rFindLast = rFindLast.Next(wdParagraph)
Wend
' Now head back up to the next numbered section header
Set rFindFirst = rFindLast
Do
Set rFindFirst = rFindFirst.Previous(wdParagraph)
Loop Until IsNumberedPara(rFindFirst) Or (rFindFirst.Previous(wdParagraph) Is Nothing)
ConvertNumberedToText rFindFirst
Dim rChangedSection As Range
Set rChangedSection = dBigDoc.Range(rFindFirst.Start, rFindLast.End)
' Properly tag all the revisions in this whole section
Dim rOnesInThisSection As Revision
For Each rOnesInThisSection In rChangedSection.Revisions
rOnesInThisSection.Range.Select ' just for visual update
DoEvents ' update the screen so we can see how far we are through
If rOnesInThisSection.Type = wdRevisionDelete Then
rOnesInThisSection.Reject
With Selection.Range
.Font.ColorIndex = wdRed
.Font.StrikeThrough = True
End With
dBigDoc.Comments.Add Selection.Range, “deleted”
Else
If rOnesInThisSection.Type = wdRevisionInsert Then
rOnesInThisSection.Accept
With Selection.Range
.Font.ColorIndex = wdBlue
End With
dBigDoc.Comments.Add Selection.Range, “inserted”
End If
End If
Next
' Now copy the whole thing into our new document
rChangedSection.Copy
Dim rOut As Range
Set rOut = dReport.Range
rOut.EndOf wdStory, False
rOut.Paste
Next rAll
' There should end up being no numbered paragraphs at all in the
' new doc (they were converted to text), so delete them
Dim pFinal As Paragraph
For Each pFinal In dReport.Paragraphs
If IsNumberedPara(pFinal.Range) Then
pFinal.Range.ListFormat.RemoveNumbers
End If
Next
dBigDoc.Close False
End If
End Sub
Sub ConvertNumberedToText(rOf As Range)
If InStr(rOf.ListFormat.ListString, “.”) > 0 Then
rOf.InsertBefore "Changes to section " + rOf.ListFormat.ListString + " "
End If
End Sub
Function IsNumberedPara(rOf As Range) As Boolean
If rOf Is Nothing Then ‘ if the document doesn’t have numbered sections, this will cause changes to be enumerated in the whole thing
IsNumberedPara = True
ElseIf rOf.ListFormat.ListString <> "" Then
If Asc(rOf.ListFormat.ListString) <> 63 Then
IsNumberedPara = True
End If
End If
End Function
I'm writing a Microsoft Word VBA macro that runs through every paragraph of a word document and adds a comment to every paragraph. That comment contains the style for that paragraph. This way a coworker can print out the document with comments and know how to style similar documents in the future.
I'm almost there, the code adds the comments to every paragraph, but dies at the first row of a table:
"This method or property is not available because the object refers to the end of a table row."
Here is the code:
Sub aa_AddStylesComment()
'
' aa_AddStylesComment Macro
' Author: Me!
'
Dim strParaStyle As String
Dim cmtNewComment As Comment
'Run through word file and delete any comments with author set to a space character (that is the author of the comments added by the script)
For J = ActiveDocument.Comments.Count To 1 Step -1
With ActiveDocument
If .Comments(J).Author = " " Then
.Comments(J).Delete
End If
End With
Next J
'Running through every paragraph
For i = 1 To ActiveDocument.Paragraphs.Count
With ActiveDocument
'Get paragraph style
strParaStyle = .Paragraphs(i).Style
'Create a new comment and collect it - then change the author to space character
Set cmtNewComment = Selection.Comments.Add(.Range(.Paragraphs(i).Range.Words(1).Start, (.Paragraphs(i).Range.Words(1).End - 1)), strParaStyle)
cmtNewComment.Author = " "
End With
Next
End Sub
You can add a check if it is a table, and then if the paragraph has cells, as follows:
If .Paragraphs(i).Range.Tables.Count = 0 Then
Set cmtNewComment = .Paragraphs(i).Range.Comments.Add(.Range(.Paragraphs(i).Range.Words(1).Start, (.Paragraphs(i).Range.Words(1).End - 1)), strParaStyle)
cmtNewComment.Author = " "
ElseIf .Paragraphs(i).Range.Cells.Count > 0 Then
Set cmtNewComment = .Paragraphs(i).Range.Comments.Add(.Range(.Paragraphs(i).Range.Words(1).Start, (.Paragraphs(i).Range.Words(1).End - 1)), strParaStyle)
cmtNewComment.Author = " "
End If
Note that you don't need to use the Selection as you never change it.
i have 3 sheets in my workbook namely sheet1 ,sheet3 and sheet2 when i enter a values from in the inputpromt say (eg:1,2 ) i split it and store it in an array it must dynamically select the sheet1 and sheet2 and print values to a file.
i have done a pseudo below can any one
Sub example()
Dim Ran As Range
Dim cnt as String
Open "D:\temp\test.txt" For Output As #1
Dim myarray() As String
Dim holder As String
dim ab as Strig
ab="this is sample data"
holder = InputBox("Enter your choice eg:1,2")
myarray = Split(holder, ",")
Dim name, country,birth As String
For i = 1 To UBound(myarray)
If i = 1 Or i = 2 Then
name = Sheets(i).Range("Z12").Value
country= Sheets(i).Range("PQ26").Value
birth = Sheets(i).Range("ab24").Value
ab=ab & name & country & birth
Print #1, ab
End If
Next i
end Sub
****in the inputbox if i give value as 1,2 then it must select values from sheet 1 and sheet2****
I am guessing you that you are trying to understand InputBox and how to split a string such as “1, 2” and process the separate values as sheet numbers.
Sheet numbers mean nothing to the user so I do not believe this is a good approach. You need to offer the user a list of worksheet tabs from which they can select.
There is InputBox and Application.InputBox. These are different and I do not like either. They come from the earliest versions of VB and were probably originally a direct match to MS-DOS’s console input. With one exception, there are much better approaches. The one exception is the ability to input a range with Application.InputBox for which I do not know a convenient alternative.
In the code below I use InputBox. You may think I have overdone the validation but what if the user enters “A”? Your code would assume “A” was a sheet number but Excel would assume it was a worksheet name and stop execution with a subscript error. You must check for any error that will cause your code to stop with a run-time error.
Instead of either InputBox you should use a User Form. There are on-line tutorials to get you started. With a User Form you have several choices including:
A List box, with multiple selection enabled, containing the names of every permitted worksheet.
A column of radio buttons, one per permitted worksheet. These would be unlinked so the user could select several.
A command button for each permitted worksheet which the user could click in turn.
All of these choices are much user-friendlier than InputBox.
Step through the code below with F8 and study what it does. Come back with questions if necessary but the more you can understand on your own the faster you will develop.
Option Explicit
' Please indent your macros consistently. This makes them much easier ri read
Sub example()
Dim Ran As Range
Dim cnt As String
Dim myarray() As String
Dim ab As String
' Variables I have added or which are replacements for yours.
Dim Answer As String
Dim AllValuesGood As Boolean
Dim InxMA As Long
Dim InxSht As Long
Dim Question As String
' I like to keep all my Dim statements together at the top.
' This makes them easier to find.
Dim name, country, birth As String
' I have output to the Immediate window which is simpler when
' experimenting.
'Open "D:\temp\test.txt" For Output As #1
Question = "Enter your choice eg: ""1"" or ""1,2"""
' You omitted the code to check the Answer
Do While True
Answer = InputBox(Question, "Experiment with Input box")
' Have a string but user could have typed anything
If Answer = "" Then
' Cannot tell if user has clicked Cancel or if user clicked Return
' before entering value. Have to assume Cancel
Debug.Print "User clicked Cancel"
Exit Sub
Else
AllValuesGood = True ' Assume good answer until find otherwise
myarray = Split(Answer, ",")
For InxMA = 0 To UBound(myarray)
If IsNumeric(myarray(InxMA)) Then
InxSht = Val(myarray(InxMA))
If InxSht < 1 Or InxSht > 2 Then
' Sheet number outside permitted range
AllValuesGood = False
Exit For
End If
Else
' Non-numeric sheet number
AllValuesGood = False
'Debug.Assert False
Exit For
End If
Next
End If
If AllValuesGood Then
' Have good answer. Exit Do-Loop to print sheets
Exit Do
Else
' An invalid sheet number has been found
Question = "Click cancel to exit or enter ""1"" or ""2"" or ""1, 2"""
' Loop to repeat Input
End If
Loop ' Until have good answer
' If get here Answer is a list of good sheet number
For InxMA = 0 To UBound(myarray)
InxSht = Val(myarray(InxMA))
' I have not created sample worksheets with data in Z12, PQ26 and ab24
' but this shows the code you need
'With Worksheets(InxSht)
' name = .Range("Z12").Value
' country = .Range("PQ26").Value
' birth = .Range("ab24").Value
'Next
name = "Name" & InxSht
country = "Country" & InxSht
birth = "Birth" & InxSht
' Have to initialise ab here because need new value per sheet
ab = "this is sample data"
ab = ab & name & country & birth
Debug.Print ab
' The value of ab will be messy because you have no spaces between words.
'Print #1, ab
Next InxMA
End Sub
I'm writing a VB Macro to do some processing of documents for my work.
The lines of text are searched and the bracketed text is put in a list(box).
The problem comes when I want to remove all hyperlinks in the document and then generate new ones (not necessarily in the location of the original hyperlinks)
So the problem is How do I remove the existing hyperlinks?
My current issue is that every time a link gets added, the hyperlinks count goes up one, but when you delete it, the count does NOT reduce. (as a result I now have a document with 32 links - all empty except for 3 I put in myself - they do not show up in the document)
At the end of the code are my attempts at removing the hyperlinks.
Private Sub FindLinksV3_Click()
ListOfLinks.Clear
ListOfLinks.AddItem Now
ListOfLinks.AddItem ("Test String 1")
ListOfLinks.AddItem ActiveDocument.FullName
SentenceCount = ActiveDocument.Sentences.Count
ListOfLinks.AddItem ("Sentence Count:" & SentenceCount)
counter = 0
For Each myobject In ActiveDocument.Sentences ' Iterate through each element.
ListOfLinks.AddItem myobject
counter = counter + 1
BracketStart = (InStr(1, myobject, "("))
If BracketStart > 0 Then
BracketStop = (InStr(1, myobject, ")"))
If BracketStop > 0 Then
ListOfLinks.AddItem Mid$(myobject, BracketStart + 1, BracketStop - BracketStart - 1)
ActiveDocument.Sentences(counter).Select
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
"http://testnolink/" & counter, ScreenTip:="" 'TextToDisplay:=""
End If
End If
Next
'ActiveDocument.Sentences(1).Select
'
'Selection.Range.Hyperlinks(1).Delete
ActiveDocument.Hyperlinks.Item(1).Delete
Debug.Print ActiveDocument.Hyperlinks.Count
End Sub
This is an old post, so am adding this VBA code in case it is useful to someone.
Hyperlinks (Collections) need to be deleted in reverse order:
Sub RemoveHyperlinksInDoc()
' You need to delete collection members starting from the end going backwards
With ActiveDocument
For i = .Hyperlinks.Count To 1 Step -1
.Hyperlinks(i).Delete
Next
End With
End Sub
Sub RemoveHyperlinksInRange()
' You need to delete collection members starting from the end going backwards
With Selection.Range
For i = .Hyperlinks.Count To 1 Step -1
.Hyperlinks(i).Delete
Next
End With
End Sub
The line removing the hyperlink is commented out. The following line will remove the first hyperlink within the selected range:
Selection.Range.Hyperlinks(1).Delete
This will also decrement Selection.Range.Hyperlinks.Count by 1.
To see how the count of links is changing you can run the following method on a document:
Sub AddAndRemoveHyperlink()
Dim oRange As Range
Set oRange = ActiveDocument.Range
oRange.Collapse wdCollapseStart
oRange.MoveEnd wdCharacter
Debug.Print ActiveDocument.Range.Hyperlinks.Count
ActiveDocument.Hyperlinks.Add oRange, "http://www.example.com"
Debug.Print ActiveDocument.Range.Hyperlinks.Count
ActiveDocument.Hyperlinks.Item(1).Delete
Debug.Print ActiveDocument.Range.Hyperlinks.Count
End Sub