#16
|
||||
|
||||
Yes, that may be. Try repairing Office (Word Options > Resources > Diagnose).
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#17
|
|||
|
|||
Still trying
Quote:
Is it possible to this fault, the fact that im using office 2010? When i show in my pc i see vbs window open without anything else inside. |
#18
|
||||
|
||||
Hi Jana,
Quote:
The following version of the code should work with whatever your Word installation calls these Styles: Code:
Sub InsertRefs() Application.ScreenUpdating = False Dim RngHd2 As Range, RngHd3 As Range, RngRef As Range, oPara As Paragraph Dim Hd1 As String, Hd2 As String, Hd3 As String With ActiveDocument Hd1 = .Styles(wdStyleHeading1).NameLocal Hd2 = .Styles(wdStyleHeading2).NameLocal Hd3 = .Styles(wdStyleHeading3).NameLocal End With With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Style = Hd2 .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute End With Do While .Find.Found Set RngHd2 = .Paragraphs(1).Range.Duplicate With RngHd2 On Error GoTo ParaLast While .Paragraphs.Last.Next.Style <> Hd1 And .Paragraphs.Last.Next.Style <> Hd2 .MoveEnd wdParagraph, 1 Wend ParaLast: If .Paragraphs.Count > 2 Then Set RngRef = RngHd2.Paragraphs(3).Range.Characters.Last .MoveStart wdParagraph, 3 Set RngHd3 = RngHd2 With RngRef .MoveEnd wdCharacter, -1 .InsertAfter " { " For Each oPara In RngHd3.Paragraphs If oPara.Style = Hd3 Then If Len(Trim(oPara.Range.Text)) > 1 Then .InsertAfter Left(oPara.Range.Text, Len(oPara.Range.Text) - 1) & ", " End If End If Next .Characters.Last.Previous.Delete .InsertAfter "}." End With End If End With .Collapse wdCollapseEnd .Find.Execute Loop End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#19
|
|||
|
|||
Oh my god!!!!!!!!!!!!!
Worked. I dont believe it. At once.
Last edited by macropod; 01-05-2012 at 03:02 PM. Reason: Deleted unneccessary quote of entire previous post |
#20
|
|||
|
|||
Is easy to put this braket text before the last full stop and not after that full stop.
something like that : textteexttezxttexttexttexttexttexttexttexttextetxt etxtextexttexttexttexttext{Heading 3, Heading 3.}. |
#21
|
||||
|
||||
Hi Jana,
Change: .MoveEnd wdCharacter, -1 to: .MoveEnd wdCharacter, -2 and change: .InsertAfter "}." to: .InsertAfter "}"
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#22
|
|||
|
|||
Worked again!!!
Quote:
Please i have something last if is possible 1. I want to remove the space before the last } 2. And also i see if the code dont find heading 3 goes to heading 2 and puts {} empty but not very usefull and i dont wanted this if i dont have correspondind heading 3 for this, 3. It is easy to convert this macro whenever i want to do tha same job for other headings? For example if heading 9 goes to heading 8, or heading 6 to heading 5? |
#23
|
||||
|
||||
Hi Jana,
Here's an improved version - it allows you to pick the Heading level! Code:
Sub InsertRefs() Application.ScreenUpdating = False Dim RngHdA As Range, RngHdB As Range, RngRef As Range Dim iRefHd As Long, StrTxt As String, oPara As Paragraph On Error Resume Next iRefHd = InputBox("What is the Reference Heading Level Number (from 1 to 8)?", "Heading Selector") ' Word's inbuilt heading styles are indexed as -2 to -10, so invert the input # and subtract 1 iRefHd = -iRefHd - 1 On Error GoTo 0 ' Valid #s must be between -2 (Heading 1) and -9 (Heading 8) If iRefHd > -2 Or iRefHd < -9 Then Exit Sub With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Style = iRefHd .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute End With Do While .Find.Found Set RngHdA = .Paragraphs(1).Range.Duplicate With RngHdA On Error GoTo ParaLast While ActiveDocument.Styles(.Paragraphs.Last.Next.Style).BuiltIn = False Or _ .Paragraphs.Last.Next.Style > ActiveDocument.Styles(iRefHd) Or _ .Paragraphs.Last.Next.Style < ActiveDocument.Styles(iRefHd + 1) .MoveEnd wdParagraph, 1 Wend ParaLast: StrTxt = "" If .Paragraphs.Count > 2 Then Set RngRef = RngHdA.Paragraphs(3).Range.Characters.Last .MoveStart wdParagraph, 3 Set RngHdB = RngHdA With RngRef .MoveEnd wdCharacter, -2 For Each oPara In RngHdB.Paragraphs If ActiveDocument.Styles(oPara.Style).BuiltIn = True Then ' To get all lower Heading Styles, change '(iRefHd - 2)' to '(-11)' If oPara.Style < ActiveDocument.Styles(iRefHd - 2) And _ oPara.Style > ActiveDocument.Styles(iRefHd) Then If Len(Trim(oPara.Range.Text)) > 1 Then StrTxt = StrTxt & Left(oPara.Range.Text, Len(oPara.Range.Text) - 1) & ", " End If End If End If Next If Len(StrTxt) > 0 Then StrTxt = "{" & Left(StrTxt, Len(StrTxt) - 2) & "}" .InsertAfter StrTxt End If End With End If End With .Collapse wdCollapseEnd .Find.Execute Loop End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#24
|
|||
|
|||
Solved
Yes is working, exact i want. Paul you are the best.
Last edited by macropod; 01-05-2012 at 03:05 PM. Reason: Deleted unneccessary quote of entire previous post |
#25
|
|||
|
|||
Macro a little bit help
Please i see that this macro works fine with the predifined styles of word. But i have another style names as you see from the document i will attach to you. Is there any option without change this macro to make work for this styles.
|
#26
|
|||
|
|||
This is the template.
|
#27
|
||||
|
||||
Quote:
a) main Style is (to attach the text to); and b) sub Style is (to attach to the main Style). There may be problems, though, if the code should not include sub Styles if they occur after some other Style that is not the main Style. Let me see what I can do.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#28
|
|||
|
|||
Quote:
|
#29
|
|||
|
|||
Difference by name style
I think that the only difference between two documents, is the name MM Topic instead Heading. And thats why macro don't working with these names. But i must tell you, that i try to change style of MM Topic to Heading 1, 2, 3, e.t.c but even after that the macro don't worked.
|
#30
|
||||
|
||||
Hi Jana,
You need to be patient - Answering forums questions is not all I do. Try the following: Code:
Sub InsertRefs() Application.ScreenUpdating = False Dim RngHdA As Range, RngHdB As Range, RngRef As Range, oPara As Paragraph Dim oSty As Style, StrStyList As String, strStyA, strStyB, StrTxt As String Dim Msg As String, MsgA As String, MsgB As String, MsgErr As String With ActiveDocument StrStyList = "|" MsgA = "What is the 'Main' Style to Find" MsgB = "What is the 'Sub' Style to Find" MsgErr = "No Such Style in this document" & vbCr For Each oSty In .Styles StrStyList = StrStyList & oSty.NameLocal & "|" Next Msg = MsgA While strStyA = "" strStyA = InputBox(Msg, "Style Selector") If strStyA = "" Then Exit Sub If InStr(StrStyList, "|" & strStyA & "|") = 0 Then strStyA = "" Msg = MsgErr & MsgA End If Wend Msg = MsgB While strStyB = "" strStyB = InputBox(Msg, "Style Selector") If strStyB = "" Then Exit Sub If InStr(StrStyList, "|" & strStyB & "|") = 0 Then strStyB = "" Msg = MsgErr & MsgB End If Wend End With With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Style = strStyA .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute End With Do While .Find.Found Set RngHdA = .Paragraphs(1).Range.Duplicate With RngHdA On Error GoTo ParaLast While .Paragraphs.Last.Next.Style <> strStyA .MoveEnd wdParagraph, 1 Wend ParaLast: If .Paragraphs.Count > 2 Then Set RngRef = RngHdA.Paragraphs(3).Range.Characters.Last .MoveStart wdParagraph, 3 Set RngHdB = RngHdA With RngRef .MoveEnd wdCharacter, -2 For Each oPara In RngHdB.Paragraphs If oPara.Style = strStyB Then If Len(Trim(oPara.Range.Text)) > 1 Then StrTxt = StrTxt & Left(oPara.Range.Text, Len(oPara.Range.Text) - 1) & ", " End If End If Next If Len(StrTxt) > 0 Then StrTxt = "{" & Left(StrTxt, Len(StrTxt) - 2) & "}" .InsertAfter StrTxt End If End With End If End With .Collapse wdCollapseEnd .Find.Execute Loop End With Application.ScreenUpdating = True End Sub Quote:
HTML Code:
Heading 1 some text Heading 2 some text Heading 3 some text Heading 1 some text Heading 3 some text
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Gray square brackets | waldux | Word | 8 | 09-25-2013 04:14 PM |
Find/Replace Brackets Problem | fatso | Word | 2 | 08-04-2011 11:34 AM |
brackets citation | uncung | Word | 1 | 07-13-2011 01:39 PM |
Brackets Issue... | DarkJudge1 | Outlook | 0 | 07-06-2010 05:15 PM |
copy a file which does not have copy option | jkind | Word | 0 | 01-17-2010 09:25 AM |