Consulting

Results 1 to 7 of 7

Thread: Copy text in a document with anchor

  1. #1
    VBAX Regular
    Joined
    Apr 2007
    Posts
    31
    Location

    Copy text in a document with anchor

    Good morning!

    I'm trying to develop a sub routine where I need to copy the next word whenever appears "Modelo:", example:

    Modelo: OPTIFLUX 2100 C
    The text I need to copy is "OPTIFLUX 2100 C", there is a tab between "Modelo:" and "OPTIFLUX 2100 C".

    The code I develop is:


    Sub Chipita_kok(W, V, Y, Z, x, New1)
    Dim Modelo1 As String
     
        New1 = ""
        Modelo1 = ""
       
        W = Selection.Information(wdActiveEndPageNumber)
        Z = Selection.Information(wdVerticalPositionRelativeToPage)
       
        On Error Resume Next
     
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = "Modelo:"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.MoveRight Unit:=wdWord, Count:=1
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        Selection.Copy
        Modelo1 = Selection
        V = Selection.Information(wdActiveEndPageNumber)
        If Left(Modelo1, 9) = "IFC 100 W" Or Left(Modelo1, 9) = "IFC 100 C" Or Left(Modelo1, 9) = "IFC 070 C" Or Left(Modelo1, 9) = "IFC 070 F" Or Left(Modelo1, 9) = "IFC 050 C" Or Left(Modelo1, 9) = "IFC 050 W" Or Left(Modelo1, 13) = "Optiflux 2000" Or Left(Modelo1, 5) = "V/Ref" Or Left(Modelo1, 13) = "Optiflux 1000" Then
        Modelo1 = ""
        If V = "" Then GoTo Fomes
        Selection.EndKey Unit:=wdLine
        x = Selection.Information(wdVerticalPositionRelativeToPage)
        Y = Selection.Information(wdVerticalPositionRelativeToPage)
     
        Else
        New1 = Modelo1
        End If
     
    Fomes:
     
        Y = Selection.Information(wdVerticalPositionRelativeToPage)
        Selection.EndKey Unit:=wdLine
        'Selection.MoveDown Unit:=wdLine, Count:=5
     
    End Sub
    It becames more complex when I need to avoid some text just like "IFC 100 W", "IFC 100 C", "IFC 070 C", (...)

    The state of the art for this routine is when appers a table just like:

    Qde Diāmetro/Flanges
    5 DN25 PN40
    1 DN32 PN40
    8 DN40 PN40
    2 DN50 PN40
    3 DN65 PN16
    6 DN80 PN40
    1 DN100 PN16



    the variable Modelo1 must be is equal to "OPTIFLUX 2100 C" as many the "Qde" times, for this table 7 times. Note: the tables appears sometimes.

    Is this possible in VBA?

    Any help will be much appreciated!

    Best regards

    Nuno
    Microsoft 2010 | VBA 7.1

  2. #2
    The part of your question
    I'm trying to develop a sub routine where I need to copy the next word whenever appears "Modelo:", example:

    Modelo: OPTIFLUX 2100 C
    The text I need to copy is "OPTIFLUX 2100 C", there is a tab between "Modelo:" and "OPTIFLUX 2100 C".
    is fairly straightforward. The rest of your question is incomprehensible.
    For a start you have asked for the next 'word' after "Modelo:" and yet your example has three words and there is no context in relation to what else is in the document or how it is formatted?
    How for example would a macro know when the required string ended? The next word would be OPTIFLUX which is easy, but how is the macro to know that you want 2100 or 2100 C also?

    You have a list of things to exclude, but what do you want to do with those words that are not excluded when they are found?
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Apr 2007
    Posts
    31
    Location
    Hello gmayor,

    Sorry if I wasn't clear enought!

    Yes you are right, in the example I gave "Optiflux 2100 C" it is three words in fact. What I want to do is to copy to the end of the line next to "Modelo:", it could be one word or more, this is what this routine do

    Selection.MoveRight Unit:=wdCharacter, Count:=1    
    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Copy     
    Modelo1 = Selection




    You have a list of things to exclude, but what do you want to do with those words that are not excluded when they are found?
    When the selection is different of "IFC 100 W", "IFC 100 C", "IFC 070 C", (...) a variable must have the same value of the selection.


    Can I help to clarify other questions?

    Regards
    Microsoft 2010 | VBA 7.1

  4. #4
    You still haven't said what you want to do with these found items, however the basic code to find them (omitting those you listed) is as follows, assuming that by 'Line' you mean 'Paragraph'

    Sub Macro1()Dim oRng As Range
    Const strFind As String = "Modelo:^t"
        Set oRng = ActiveDocument.Range
        With oRng.Find
            Do While .Execute(FindText:=strFind)
                oRng.Collapse 0
                oRng.End = oRng.Paragraphs(1).Range.End - 1
                If Not Left(oRng.Text, 9) = "IFC 100 W" Or _
                   Not Left(oRng.Text, 9) = "IFC 100 C" Or _
                   Not Left(oRng.Text, 9) = "IFC 070 C" Or _
                   Not Left(oRng.Text, 9) = "IFC 070 F" Or _
                   Not Left(oRng.Text, 9) = "IFC 050 C" Or _
                   Not Left(oRng.Text, 9) = "IFC 050 W" Or _
                   Not Left(oRng.Text, 13) = "Optiflux 2000" Or _
                   Not Left(oRng.Text, 5) = "V/Ref" Or _
                   Not Left(oRng.Text, 13) = "Optiflux 1000" Then
                    'do what you want with oRng here e.g.
                    MsgBox oRng.Text
                End If
                oRng.Collapse 0
            Loop
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Regular
    Joined
    Apr 2007
    Posts
    31
    Location
    Quote Originally Posted by gmayor View Post
    You still haven't said what you want to do with these found items, however the basic code to find them (omitting those you listed) is as follows, assuming that by 'Line' you mean 'Paragraph'
    The Objective is to put that found items in a Microsoft Office Spreadsheet 11.0 which is in a userform


    Thank you gmayor!
    Microsoft 2010 | VBA 7.1

  6. #6
    The following will add the found items to an array and you can write that array to a worksheet as shown
    Sub Macro1()
    Dim arrList() As String
    Dim oRng As Range
    Dim xlApp As Object
    Dim xlBook As Object
    Dim NextRow As Integer, i As Integer
    Const strFind As String = "Modelo:^t"
        Set oRng = ActiveDocument.Range
        ReDim arrList(0)
        With oRng.Find
            Do While .Execute(FindText:=strFind)
                oRng.Collapse 0
                oRng.End = oRng.Paragraphs(1).Range.End - 1
                If Not Left(oRng.Text, 9) = "IFC 100 W" Or _
                   Not Left(oRng.Text, 9) = "IFC 100 C" Or _
                   Not Left(oRng.Text, 9) = "IFC 070 C" Or _
                   Not Left(oRng.Text, 9) = "IFC 070 F" Or _
                   Not Left(oRng.Text, 9) = "IFC 050 C" Or _
                   Not Left(oRng.Text, 9) = "IFC 050 W" Or _
                   Not Left(oRng.Text, 13) = "Optiflux 2000" Or _
                   Not Left(oRng.Text, 5) = "V/Ref" Or _
                   Not Left(oRng.Text, 13) = "Optiflux 1000" Then
                    ReDim Preserve arrList(UBound(arrList) + 1)
                    arrList(UBound(arrList)) = oRng.Text
                End If
                oRng.Collapse 0
            Loop
        End With
        On Error Resume Next
        Set xlApp = GetObject(, "Excel.Application")
        If Err Then
            Set xlApp = CreateObject("Excel.Application")
        End If
        On Error GoTo 0
        Set xlBook = xlApp.Workbooks.Add
        xlBook.Sheets(1).Cells(1, 1).value = "Modelo"
        xlApp.Visible = True
        For i = 0 To UBound(arrList)
            NextRow = xlBook.Sheets(1).Range("A" & xlBook.Sheets(1).Rows.Count).End(-4162).Row + 1
            xlBook.Sheets(1).Cells(NextRow, 1).value = arrList(i)
        Next i
    lbl_Exit:
        Set oRng = Nothing
        Set xlApp = Nothing
        Set xlBook = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    VBAX Regular
    Joined
    Apr 2007
    Posts
    31
    Location
    Sorry gmayor for the late reply, I was out of the country in vacations.

    What I intend to do is to put those found words in a userform textbox.

    Based on the last code you posted i developed the following code that works better for what I intend to do:

    Sub Macro99()
    Dim oRng As range
    Const strFind As String = "Modelo:^t" 
         
        Set oRng = ActiveDocument.range
        With oRng.Find
            Do While .Execute(FindText:=strFind)
                oRng.Collapse 0
                oRng.End = oRng.Paragraphs(1).range.End - 1
                            
                If Left(oRng.Text, 9) = "IFC 100 W" Or _
                   Left(oRng.Text, 9) = "IFC 100 C" Or _
                   Left(oRng.Text, 9) = "IFC 070 C" Or _
                   Left(oRng.Text, 9) = "IFC 070 F" Or _
                   Left(oRng.Text, 9) = "IFC 050 C" Or _
                   Left(oRng.Text, 9) = "IFC 050 W" Or _
                   Left(oRng.Text, 9) = "IFC 300 W" Or _
                   Left(oRng.Text, 9) = "MAC 100" Or _
                   Left(oRng.Text, 17) = "OPTISENS ODO 2000" Or _
                   Left(oRng.Text, 13) = "Optiflux 2000" Or _
                   Left(oRng.Text, 17) = "SMARTPAT ORP 1590" Or _
                   Left(oRng.Text, 16) = "Waterflux 3000 F" Or _
                   Left(oRng.Text, 13) = "Optiflux 1000" Or _
                   Left(oRng.Text, 15) = "Optiflux 2000 F" Then
                    GoTo 1
                End If
                      MsgBox oRng.Text
    1:
              oRng.Collapse 0
            Loop
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub
    Just one more question: Could we find more than one word?
    Last edited by dzogchen; 08-07-2019 at 07:46 AM.
    Microsoft 2010 | VBA 7.1

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •