Consulting

Results 1 to 4 of 4

Thread: Fields to Wildcards (text) (VBA, word, macro)

  1. #1

    Fields to Wildcards (text) (VBA, word, macro)

    Hello world

    I'm having some problems creating a macro in VBA for Word (2010).

    So far I made it (with the search function of these forums) to loop through all sections and find fields and to delete them and insead insert own TEXT pattern.
    At the moment my code looks like this:

    [VBA]
    Option Explicit

    Public Sub FieldsToWildcards()

    Dim aField As field
    Dim pRange As Word.Range
    Dim pattern As String

    For Each pRange In ActiveDocument.StoryRanges

    For Each aField In pRange.Fields
    Set pRange = aField.Code
    aField.Delete
    pRange.Collapse (wdCollapseStart)
    pRange.Text = "${A[;B]}"
    Next

    Next

    End Sub
    [/VBA]

    I now need some line of code, which will transform this:

    { IF «sex» = "f" "She" "He" }, (which is btw. a field) INTO this ${She;He} (text)

    AND this:

    { MERGEFIELD Name } (field) INTO this ${Name} (text)


    I would appreciate any help.

    Thank you,
    Kind regards

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Hi Julian,

    See:
    http://www.gmayor.com/export_field.htm#FieldToText
    and, to reverse the process:
    http://www.gmayor.com/export_field.htm#TextToField
    As coded, the first macro simply puts the output into the Windows Clipboard. If you want to overwrite the selection automatically, replace the last three code lines with:
    Selection.Text = NewString
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    Thank you. I will have a look and post back.

  4. #4

    Thumbs up Finished

    So I've managed it to do it this way and it does the job i need.

    [VBA]
    Option Explicit

    Public Sub FieldsToWildcards()
    '
    ' FieldsToWildcards Macro
    ' Convertes Fields to Wildcards (strings)
    '

    Dim pRange As Word.Range
    Dim aField As field
    Dim currFieldCode As String
    Dim wildcard As String

    Dim mfIfParamsCount1 As Integer
    mfIfParamsCount1 = 6
    Dim mfIfParamsCount2 As Integer
    mfIfParamsCount2 = 7

    Dim mfIfParams1 As Variant
    Dim param1Pos As Integer
    param1Pos = 4

    Dim mfIfParams2 As Variant
    Dim param2Pos As Integer
    param2Pos = 1
    Dim param3Pos As Integer
    param3Pos = 3
    Dim param4Pos As Integer
    param4Pos = 5

    Dim mfTypePos As Integer
    mfTypePos = 2
    Dim mfVarStart As Integer
    mfVarStart = 13

    Dim dqASCIICode As Integer
    dqASCIICode = 34

    'Loop through all ranges (also header and footer)
    For Each pRange In ActiveDocument.StoryRanges

    'Loop through all fields in current range
    For Each aField In pRange.Fields
    Set pRange = aField.Code
    currFieldCode = aField.Code
    wildcard = "${"

    'IF-MERGEFIELD
    If InStr(1, currFieldCode, "IF") = mfTypePos Then
    'Get parameters for wildcard (second part)
    mfIfParams2 = Split(currFieldCode, Chr(dqASCIICode), mfIfParamsCount2)

    'Get parameter(s) for wildcard (first part)
    mfIfParams1 = Split(mfIfParams2(0), " ", mfIfParamsCount1)

    'Add first parameter to wildcard
    wildcard = wildcard & Trim(mfIfParams1(param1Pos)) & ";"
    'Add second parameter to wildcard
    wildcard = wildcard & Trim(mfIfParams2(param2Pos)) & ";"
    'Add third parameter to wildcard
    wildcard = wildcard & Trim(mfIfParams2(param3Pos)) & ";"
    'Add fourth parameter to wildcard
    wildcard = wildcard & Trim(mfIfParams2(param4Pos)) & "}"

    'MsgBox wildcard

    'Delete field
    aField.Delete

    'Add wildcard insead
    pRange.Collapse wdCollapseStart
    pRange.Text = wildcard
    Else
    If InStr(1, currFieldCode, "MERGEFIELD") = mfTypePos Then
    wildcard = wildcard & Trim(Mid(currFieldCode, mfVarStart, Len(currFieldCode) - mfVarStart)) & "}"

    'MsgBox wildcard

    'Delete field
    aField.Delete

    'Add wildcard insead
    pRange.Collapse wdCollapseStart
    pRange.Text = wildcard
    End If
    End If
    Next
    Next

    End Sub
    [/VBA]

    Thank you again!
    Sincerely, me
    Last edited by julianP; 01-13-2012 at 11:05 AM.

Posting Permissions

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