none
Help with the right code for a MACRO word RRS feed

  • Question

  • Hello all of you good people,

      I am using office 2000 but have no background on VBA programming
    I would be interested in a macro or the code which would execute two tasks simultaneously by hitting the enter key or any short cut, i need it for astrological calculation which a hobby of mine.
    In order to do my calculation i type a text (usually a long sentence between 50 up to 300 characters) the text is made of characters separated from each other and  the text is always different, i am using Rtl para and Arabic keyboard (3073)
    - First task i would like  the macro to execute is to calculate the sum up of the characters i typed and place the total at the top ( as a first line), the sum up is calculated based on the following values if used in the entered text:
    Text:=ChrW(1571) & " = 1 ";  ChrW(1575) & " = 1"; ChrW(1569) & " = 1"; ChrW(1573) & " =1"; ChrW(1576) & " =2 "; ChrW(1580) & " = 3"; ChrW(1583) & " = 4"; ChrW(1607) & " = 5"; ChrW(1608) & " = 6 "; ChrW(1572) & "= 6"; ChrW(1586) & " = 7"; ChrW(1581) & " = 8 "; ChrW(1591) & " = 9 "; ChrW(1610) & " = 10"; ChrW(1609) & " = 10"; ChrW(1574) & " = 10"; ChrW(1603) & " =20"; ChrW(1604) & " = 30"; ChrW(1575) & " = 31"; ChrW(1605) & " = 40"; ChrW(1606) & " = 50"; ChrW(1587) & " = 60"; ChrW(1593) & " = 70"; ChrW(1601) & " = 80";  ChrW(1589) & "90"; ChrW(1602) & " = 100"; ChrW(1585) & " = 200"; ChrW(1588) & " = 300"; ChrW(1578) & " = 400"; ChrW(1577) & " = 400"; ChrW(1579) & " = 500"; ChrW(1582) & " = 600"; ChrW(1584) & " = 700"; ChrW(1590) & " = 800"; ChrW(1592) & " = 900"; ChrW(1594) & " = 1000"; --end---
    -Second thing which is the main task is the cursor goes below the paragraph i typed and starts typing the same characters but in the following order:
    the last character of the previous paragraph becomes in position 1 followed  by the first character, then the before last character followed by the second character and so on ... i will use numbers instead of letters as example so that you may better understand, to make it easy i will only use numbers from 1 to 9 : 1 is character in position 1 and 9 will be position end or last character:

    1 2 3 4 5 6 7 8 9  

    9 1 8 2 7 3 6 4 5  

    5 9 4 1 6 8 3 2 7

    7 5 2 9 3 4 8 1 6

    6 7 1 5 8 2 4 9 3

    3 6 9 7 4 1 2 5 8

    8 3 5 6 2 9 1 7 4

    4 8 7 3 1 5 9 6 2

    2 4 6 8 9 7 5 3 1

    1 2 3 4 5 6 7 8 9

    -- end ---

    so basically the characters with  color blue are to be achieved automatically by the macro ( the iterating of characters), when ever the in put line or paragraph reoccurs that' s the end of the iterating of the characters, if i use letters it will look like this :


    i n p u t l i n e

    e i n n i p l u t

    t e u i l n p n i

    i t n e p u n i l

    l i i t n n u e p

    p l e i u i n t n

    n p t l n e i i u

    u n i p i t e l n

    n u l n e i t p i

    i n p u t l i n e

    I hope you got the idea,

    Of course I am willing to reward anyone for his/ her time, willing to help

    Looking forwards to hearing from you

     

    Friendly regards

    Hosny BA


    • Edited by Hosny BA Thursday, September 15, 2011 11:48 PM
    Thursday, September 15, 2011 11:47 PM

Answers

  • The following code will handle the string with spaces between the characters:

    Dim i As Long, j As Long
    Dim arrchars As Variant
    Dim rng As Range
    Dim str As String
    Set rng = ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range
    rng.End = rng.End - 1
    arrchars = Split(rng.Text, " ")
    For i = 0 To UBound(arrchars)
        str = ""
        For j = UBound(arrchars) To UBound(arrchars) / 2 + 1 Step -1
            str = str & arrchars(j) & " " & arrchars(UBound(arrchars) - j) & " "
        Next j
        If (UBound(arrchars) + 1) Mod 4 <> 0 And (UBound(arrchars) + 1) Mod 2 = 0 Then
            str = str & arrchars((UBound(arrchars) + 1) / 2) & " " & arrchars((UBound(arrchars) + 1) / 2 - 1)
        End If
        If UBound(arrchars) Mod 2 = 0 Then
            str = str & arrchars(UBound(arrchars) / 2)
        End If
        rng = rng & vbCr & RTrim(str)
        Set rng = ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range
        rng.End = rng.End - 1
        arrchars = Split(rng.Text, " ")
    Next i

    Note however, that the original pattern will be repeated after the following number of iterations for the various numbers of characters in the original string:

     Characters Iterations
    3 3
    4 3
    5 5
    6 6
    7 4
    8 8
    9 9
    10 6
    11 11
    12 10
    13 9
    14 14
    15 5
    16 5
    17 12
    18 18
    19 12
    20 10
    21 7
    22 12
    23 23
    24 21
    25 8
    26 26
    27 20
    28 18
    29 29
    30 30
    31 5
    32 6
    33 33
    34 20
    35 35
    36 9

    I have not attempted to come up with the logic for terminating the code after the required number of iterations and as a result, running the code on the string in your post, the following is the result:

    C V B O K L L G X B L P A W T

    T C W V A B P O L K B L X L G

    G T L C X W L V B A K B L P O

    O G P T L L B C K X A W B L V

    V O L G B P W T A L X L K B C

    C V B O K L L G X B L P A W T - Original Order

    T C W V A B P O L K B L X L G

    G T L C X W L V B A K B L P O

    O G P T L L B C K X A W B L V

    V O L G B P W T A L X L K B C

    C V B O K L L G X B L P A W T - Original Order

    T C W V A B P O L K B L X L G

    G T L C X W L V B A K B L P O

    O G P T L L B C K X A W B L V

    V O L G B P W T A L X L K B C

    C V B O K L L G X B L P A W T - Original Order


    Doug Robbins - Word MVP dkr[atsymbol]mvps[dot]org
    Sunday, September 25, 2011 6:27 AM

All replies

  • I am not really sure what you want calculated in the first part of your question, but for the second part, if the string that you want manipulated is the last paragraph in a document, the following will do what you want (It should handle either even or odd length strings:

    Dim i As Long, j As Long
    Dim rng As Range
    Dim str As String
    Set rng = ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range
    rng.End = rng.End - 1
    For i = 2 To rng.Characters.Count + 1
        str = ""
        If rng.Characters.Count Mod 2 = 1 Then
            For j = rng.Characters.Count To rng.Characters.Count / 2 + 1 Step -1
                str = str & rng.Characters(j) & rng.Characters(rng.Characters.Count - j + 1)
            Next j
            str = str & rng.Characters(Int(rng.Characters.Count / 2) + 1)
        Else
            For j = rng.Characters.Count To rng.Characters.Count / 2 + 1 Step -1
                str = str & rng.Characters(j) & rng.Characters(rng.Characters.Count - j + 1)
            Next j
        End If
        rng = rng & vbCr & str
        Set rng = ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range
        rng.End = rng.End - 1
    Next i


    Doug Robbins - Word MVP dkr[atsymbol]mvps[dot]org
    Friday, September 16, 2011 10:51 AM
  • Hey Doug

    Thanks for your reply, i will try the code you posted and will get back to you,

    about the calculation what i meant is : if i attribute a numeric value to all characters :

    For instance if i attribute the value of 1 to the letter a, and the value of 7 to j then if type a b = 8 

    anyway thank you for your help and i'll let you know

     

    Friday, September 16, 2011 3:29 PM
  • Well doug i copied the code you posted to MVB and assigned the Macro to short key Alt+I but nothing happened

    Am I missing something?

    Thank you for your time

    Friday, September 16, 2011 3:43 PM
  • See the article "What do I do with macros sent to me by other newsgroup readers to help me out?” at:

    http://www.word.mvps.org/FAQs/MacrosVBA/CreateAMacro.htm

    If I start with the following as the last paragraph in a document

    123456789

     

    and run the macro, it adds the following to the document

     

    918273645

    594168327

    752934816

    671582493

    369741258

    835629174

    487315962

    246897531

    123456789

     

    If I start with:

     

    12345678

     

    it adds:

     

    81726354

    48513762

    24687531

    12345678

    81726354

    48513762

    24687531

    12345678

     

    I still do not understand the first part of your question


    Doug Robbins - Word MVP dkr[atsymbol]mvps[dot]org
    Friday, September 16, 2011 9:39 PM
  • Hi Doug

    I tried everything i could to get the code to word by copying the same code you posted to VBE but in vain

    Could it be the office version which is causing the problem? as i mentioned i am using Office 2000 on Windows 7 platform

    I mean i can record a simple macro without a problem then run it either by shortcut key or by clicking : Tools>Macros> Macro' s ...

    There is something i can' t get my head around ...

    The First part is simple,  let us assume i use only numbers in my string and the value of the character is the normal known value 0=0, 1=1 , 2=2, 3=3...7=7, 8=8, 9=9

    so if i type a paragraph containing only numbers example:  4 8 9 0 5 7 2 8 0 3 9 1 = total is 4+8+9+0+5+7+2+8+0+3+9+1 = 56

    The same goes for letters, if i assign certain values to the Letters of the alphabet like this: a=1, b=2, c=3, d=4, e=5, f=6, g=7, h=8 .... suppose i type a string made of : c f g a h b    then what i want the macro to do is to calculate the total sum of the letters: 3+6+7+1+8+2= total is 27

    Seen i am using a completely different alphabet from the Latin alphabet, that' s why i posted the code for the characters and not the characters themselves because they would look like Chinese (lol)

    If i try to make it comprehensive while using Latin alphabet then :

    a=ChrW(1571) & " = 1 ";  á=ChrW(1575) & " = 1"; ä=ChrW(1569) & " = 1"; A=ChrW(1573) & " =1"; b=ChrW(1576) & " =2 "; c= ChrW(1580) & " = 3"; d=ChrW(1583) & " = 4"; e=ChrW(1607) & " = 5"; f=ChrW(1608) & " = 6 "; g=ChrW(1572) & "= 6"; h=ChrW(1586) & " = 7"; i=ChrW(1581) & " = 8 "; j=ChrW(1591) & " = 9 "; k=ChrW(1610) & " = 10"; ChrW(1609) & " = 10"; K=ChrW(1574) & " = 10"; l=ChrW(1603) & " =20"; m=ChrW(1604) & " = 30"; n=ChrW(1575) & " = 31"; p=ChrW(1605) & " = 40"; o=ChrW(1606) & " = 50"; p=ChrW(1587) & " = 60"; q=ChrW(1593) & " = 70"; r=ChrW(1601) & " = 80";  s=ChrW(1589) & "90"; t= ChrW(1602) & " = 100"; u=ChrW(1585) & " = 200"; v=ChrW(1588) & " = 300"; w=ChrW(1578) & " = 400"; W=ChrW(1577) & " = 400"; x=ChrW(1579) & " = 500"; y=ChrW(1582) & " = 600"; ?=ChrW(1584) & " = 700"; /=ChrW(1590) & " = 800"; '=ChrW(1592) & " = 900"; z=ChrW(1594) & " = 1000";

    But for me the most important is the iterating of the characters, which i am still struggling to get the macro do.

    Could it be i' ll have to change something in the registry code of office word to get the code work properly?

    Cheers, 

     


    • Edited by Hosny BA Saturday, September 17, 2011 7:25 PM
    Saturday, September 17, 2011 7:24 PM
  • Hi Doug

    Obviously there is a compatibility issue when running word office 2000 on windows 7 platform

    I had to play around the VBE and could have the macro do its task (not sure yet what the real bug is )

    but it seems to attach letters to each other in the iteration action i used the following string:

     

    C V B O K L L G X B L P A W T
    TC  WV  AB  PO  LK  BL  XL  G
    GT C  L XW V  L BA B  K LP O 
     GOT  PCL   KL   XBW  AVB   L
    L  G O TB V AP C LW B X  K L 
     LL   KG   OX  TBB  WVL  ACP 
      PLCLA     LKVGW     BOBXT  
        TPXLBCOLBA          WLGKV
    V K G L WT P X L B C O L B A 
     VA  KB  GL  LO  WCT  BP  LX 
      XVLA    PKBB    TGCLW    LO
    O L  X V L AW L C G TP K B B 
     OB  LB   KX  PVT  LG  ACW  L
    L  O BW C AL B  G L  K XT V P
    PL  V  OT XB WK  C  LA LG  B 
     PBL    GVL   AOLT   XCB   WK
    K WP B L  B C X  G V LT L O A
    AK  OW PL  BT LL  V  BG  C  X
    XA K  C  O WG BP L  V  B TL L
    LX AL TK  B  C  V  O  LW GP B
    BL XP GA LW LT K  O  B  V  C 
     BCL   XVP   GBA   LOW   LKT 
      TBKCLL      WXOVLP      AGB
    B G AT B K C L L  P L V O X W
    WB  XG  OA TV  BL  KP  C  LL 
     WLBL    XCG    POKA   TLVB  
       WBLVBLLT       AXKCOGP    
           WPBGLOVCBKLXLAT       
                  TWAPLBXGLLKOBVC
    C V B O K L L G X B L P A W T
    

     


    Is there a way to keep the characters apart from each other in the iteration lines?

    Because at line 3, two characters are considered as 1 so instead of treating the charactersone at a time,

    see :

    TC  WV  AB  PO  LK  BL  XL  G
    GT C  L XW V  L BA B  K LP O 

    correct order should be :

    TC  WV  AB  PO  LK  BL  XL  G
    G T L C X  W L V B A K B L P O 
    the macro seems to ignore the first character and picks the last character of a the attached characters ...     

    i am getting close thank you Doug for your kind help, what can i offer you in return sir?

    friendly regards

     



    • Edited by Hosny BA Saturday, September 17, 2011 10:57 PM
    Saturday, September 17, 2011 10:38 PM
  • The following code will handle the string with spaces between the characters:

    Dim i As Long, j As Long
    Dim arrchars As Variant
    Dim rng As Range
    Dim str As String
    Set rng = ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range
    rng.End = rng.End - 1
    arrchars = Split(rng.Text, " ")
    For i = 0 To UBound(arrchars)
        str = ""
        For j = UBound(arrchars) To UBound(arrchars) / 2 + 1 Step -1
            str = str & arrchars(j) & " " & arrchars(UBound(arrchars) - j) & " "
        Next j
        If (UBound(arrchars) + 1) Mod 4 <> 0 And (UBound(arrchars) + 1) Mod 2 = 0 Then
            str = str & arrchars((UBound(arrchars) + 1) / 2) & " " & arrchars((UBound(arrchars) + 1) / 2 - 1)
        End If
        If UBound(arrchars) Mod 2 = 0 Then
            str = str & arrchars(UBound(arrchars) / 2)
        End If
        rng = rng & vbCr & RTrim(str)
        Set rng = ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range
        rng.End = rng.End - 1
        arrchars = Split(rng.Text, " ")
    Next i

    Note however, that the original pattern will be repeated after the following number of iterations for the various numbers of characters in the original string:

     Characters Iterations
    3 3
    4 3
    5 5
    6 6
    7 4
    8 8
    9 9
    10 6
    11 11
    12 10
    13 9
    14 14
    15 5
    16 5
    17 12
    18 18
    19 12
    20 10
    21 7
    22 12
    23 23
    24 21
    25 8
    26 26
    27 20
    28 18
    29 29
    30 30
    31 5
    32 6
    33 33
    34 20
    35 35
    36 9

    I have not attempted to come up with the logic for terminating the code after the required number of iterations and as a result, running the code on the string in your post, the following is the result:

    C V B O K L L G X B L P A W T

    T C W V A B P O L K B L X L G

    G T L C X W L V B A K B L P O

    O G P T L L B C K X A W B L V

    V O L G B P W T A L X L K B C

    C V B O K L L G X B L P A W T - Original Order

    T C W V A B P O L K B L X L G

    G T L C X W L V B A K B L P O

    O G P T L L B C K X A W B L V

    V O L G B P W T A L X L K B C

    C V B O K L L G X B L P A W T - Original Order

    T C W V A B P O L K B L X L G

    G T L C X W L V B A K B L P O

    O G P T L L B C K X A W B L V

    V O L G B P W T A L X L K B C

    C V B O K L L G X B L P A W T - Original Order


    Doug Robbins - Word MVP dkr[atsymbol]mvps[dot]org
    Sunday, September 25, 2011 6:27 AM
  • Doug seems to have solved the second part.  For the first, you should be able to use something like this:

    Sub SubSum()
    Dim i As Long, j As Long
    Dim arrchars As Variant
    Dim rng As Range
    Dim str As String
    Dim lngSum As Long
    Set rng = ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range
    rng.End = rng.End - 1
    arrchars = Split(rng.Text, " ")
    For i = 0 To UBound(arrchars)
      Select Case AscW(arrchars(i))
        Case 1571
          lngSum = lngSum + 1
        Case 1575
          lngSum = lngSum + 1
        'and so on ...
        'You need to add the remain Case statement.
        Case 1592
          lngSum = lngSum + 900
        Case 1594
          lngSum = lngSum + 1000
        'Testing
        Case 65 'A
          lngSum = lngSum + 1
        Case 66 'B
          lngSum = lngSum + 2
        Case 67 'C
          lngSum = lngSum + 3
      End Select
    Next i
    rng.InsertBefore lngSum & vbCr
    End Sub

     


    Greg Maxey Please visit my website at: http://gregmaxey.mvps.org/word_tips.htm
    Sunday, September 25, 2011 1:25 PM
  • Hey Doug and Greg,

    Thank you both ever so much for providing me the right code, i really appreciate

    It is thoughtful of you Doug to alter the code so that it adds space between the characters in the iteration lines, actually it was initially my fault for not indicating the after i type the text i always have to insert a space between the characters in order for the iteration lines to be neat and clear, but obviously the code did not work for me first because i had spaces between all characters, it was only when  Bernie explained that the input text must not contain any space? Well normally when i type the input the next step is insert spaces between all the characters, so may be it would be a wise thing to indent property or some method to keep the characters spaced without inserting spaces but rather work on text property so that spaces won't be considered as characters in iterating lines...   

    For the time being I'll will copy and use both codes and see what i'll get and let you know

    Thank you both for your help, really appreciate it

     

     

    Monday, September 26, 2011 9:22 PM
  • Doug !

    You're the best friend!

    The code you posted works very well, thank you for taking the time and for your help

    About the code Greg posted, I completed the list of the characters but when i run the Macro it does not seem to do its task as expected. Even when i typed a paragraph without any space between the words it did not sum up the given values...

    Something not quiet in place, but thank you for the tip 

    Friendly regards

    Hosny BA 

    Thursday, September 29, 2011 8:51 PM