Please help copy inside brackets

macropod · #16 01-02-2012, 03:45 PM

Yes, that may be. Try repairing Office (Word Options > Resources > Diagnose).

Jana · #17 01-03-2012, 04:00 AM

Quote:

Originally Posted by macropod

Yes, that may be. Try repairing Office (Word Options > Resources > Diagnose).

I try this macro to another pc, but still take 5834 and yellow heading 2.
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.

macropod · #18 01-03-2012, 02:49 PM

Hi Jana,

Quote:

Is it possible to this fault, the fact that im using office 2010?

No. I developed the code on Office 2010. The error suggests the document you're running the code on does not have a Style named 'Heading 2'.

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

Jana · #19 01-03-2012, 03:31 PM

Worked. I dont believe it. At once.

Jana · #20 01-03-2012, 03:35 PM

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.}.

macropod · #21 01-03-2012, 03:38 PM

Hi Jana,

Change:
.MoveEnd wdCharacter, -1
to:
.MoveEnd wdCharacter, -2
and change:
.InsertAfter "}."
to:
.InsertAfter "}"

Jana · #22 01-03-2012, 04:14 PM

Quote:

Originally Posted by macropod

Hi Jana,

Change:
.MoveEnd wdCharacter, -1
to:
.MoveEnd wdCharacter, -2
and change:
.InsertAfter "}."
to:
.InsertAfter "}"

Fantastic. This working really good.
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?

macropod · #23 01-03-2012, 09:04 PM

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

As coded, the macro only looks reports Heading Styles one level below the chose one. To get all lower Heading Styles, change '(iRefHd - 2)' to '(-11)' where indicated in the code.

Jana · #24 01-04-2012, 04:13 AM

Yes is working, exact i want. Paul you are the best.

Jana · #25 01-04-2012, 09:55 AM

Quote:

Originally Posted by Jana

Yes is working, exact i want. Paul you are the best.

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.

Jana · #26 01-04-2012, 09:58 AM

Quote:

Originally Posted by Jana

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.

This is the template.

macropod · #27 01-04-2012, 09:01 PM

Quote:

Originally Posted by Jana

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.

Yes, it can be made to work with other Styles, but that takes more work - and you will have to tell it what the:
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.

Jana · #28 01-05-2012, 03:03 AM

Quote:

Originally Posted by macropod

Yes, it can be made to work with other Styles, but that takes more work - and you will have to tell it what the:
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.

I ve attached the template document with the styles i want to work to the previous reply. If you see the macro dont work with this styles. Even if i try to convert this to Heading 1, Heading 2 and e.t.c But the makro works fine with all predefined styles of word withoun any change. This i want to do, is without anything change the main macro because the previous code was simple and very good to work with this styles

Jana · #29 01-05-2012, 05:17 AM

Quote:

Originally Posted by Jana

This is the template.

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.

macropod · #30 01-05-2012, 01:50 PM

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

As I said before:

Quote:

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.

This could mean that if you have:

HTML Code:

Heading 1
  some text
Heading 2
  some text
Heading 3
  some text
Heading 1
  some text
Heading 3
  some text

and you are looking for 'Heading 2' (main) and 'Heading 3' (sub), the last 'Heading 3' will be reported for the 'Heading 2' when it shouldn't be. Let me know if this is a problem.

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