' Paste this macro carefully between the "Sub" and "End sub" lines. ' NAME THIS MACRO AS FOLLOWS: Pinyin_1_selected_cells() ' Name it by copying and paste that name EXACTLY after the word "Sub" above, ' erasing any other name you may have given this macro, OR ELSE THE ' WORKSHEET AND WORKBOOK VERIONS WILL NOT RUN. ' ' About this macro: ' ' Pinyin Joe 's Tone Mark Macro for Excel ' Version 1.1, released June 2008 ' Copyright (c) 2005-2008 pinyinjoe.com ' http://www.pinyinjoe.com ' ' Based on the algorithm in Pinyin Joe's Tone Mark Macro for Word. ' Code port from Word to Excel by Tushar Kapila, http://sel2in.com ' Further code and algorithm modification by Pinyin Joe, http://www.pinyinjoe.com ' FOR TECHNICAL SUPPORT, CONTACT: http://www.pinyinjoe.com/contact.htm ' ' Begin macro: ' ' (1) Move number from end-of-word to after-vowels. ' (a) Lower case Selection.Replace What:="n1", Replacement:="1n", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="n2", Replacement:="2n", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="n3", Replacement:="3n", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="n4", Replacement:="4n", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ng1", Replacement:="1ng", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ng2", Replacement:="2ng", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ng3", Replacement:="3ng", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ng4", Replacement:="4ng", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="r1", Replacement:="1r", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="r2", Replacement:="2r", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="r3", Replacement:="3r", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="r4", Replacement:="4r", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True ' (b) Upper case Selection.Replace What:="N1", Replacement:="1N", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="N2", Replacement:="2N", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="N3", Replacement:="3N", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="N4", Replacement:="4N", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="NG1", Replacement:="1NG", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="NG2", Replacement:="2NG", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="NG3", Replacement:="3NG", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="NG4", Replacement:="4NG", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="R1", Replacement:="1R", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="R2", Replacement:="2R", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="R3", Replacement:="3R", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="R4", Replacement:="4R", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True ' ' (2) Move from after-all-vowels to syllable nucleus. ' (a) Lower case Selection.Replace What:="ai1", Replacement:="a1i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ai2", Replacement:="a2i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ai3", Replacement:="a3i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ai4", Replacement:="a4i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ao1", Replacement:="a1o", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ao2", Replacement:="a2o", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ao3", Replacement:="a3o", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ao4", Replacement:="a4o", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ei1", Replacement:="e1i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ei2", Replacement:="e2i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ei3", Replacement:="e3i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ei4", Replacement:="e4i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ei5", Replacement:="e5i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ou1", Replacement:="o1u", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ou2", Replacement:="o2u", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ou3", Replacement:="o3u", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="ou4", Replacement:="o4u", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True ' (2)(b) Upper case. Selection.Replace What:="AI1", Replacement:="A1I", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="AI2", Replacement:="A2I", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="AI3", Replacement:="A3I", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="AI4", Replacement:="A4I", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="AO1", Replacement:="A1O", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="AO2", Replacement:="A2O", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="AO3", Replacement:="A3O", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="AO4", Replacement:="A4O", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="EI1", Replacement:="e1i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="EI2", Replacement:="E2I", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="EI3", Replacement:="E3I", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="EI4", Replacement:="E4I", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="OU1", Replacement:="O1U", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="OU2", Replacement:="O2U", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="OU3", Replacement:="O3U", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="OU4", Replacement:="O4U", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True ' (2)(c) Mixed case: initial cap vowel followed by lower case vowel. Selection.Replace What:="Ai1", Replacement:="A1i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ai2", Replacement:="A2i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ai3", Replacement:="A3i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ai4", Replacement:="A4i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ao1", Replacement:="A1o", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ao2", Replacement:="A2o", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ao3", Replacement:="A3o", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ao4", Replacement:="A4o", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ei1", Replacement:="e1i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ei2", Replacement:="E2i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ei3", Replacement:="E3i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ei4", Replacement:="E4i", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ou1", Replacement:="O1u", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ou2", Replacement:="O2u", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ou3", Replacement:="O3u", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="Ou4", Replacement:="O4u", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True ' ' (3) Replace letter-&-number with Unicode character. ' (a) Lower case. Selection.Replace What:="a1", Replacement:=ChrW(&H101), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="a2", Replacement:=ChrW(&HE1), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="a3", Replacement:=ChrW(&H1CE), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="a4", Replacement:=ChrW(&HE0), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="e1", Replacement:=ChrW(&H113), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="e2", Replacement:=ChrW(&HE9), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="e3", Replacement:=ChrW(&H11B), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="e4", Replacement:=ChrW(&HE8), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="i1", Replacement:=ChrW(&H12B), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="i2", Replacement:=ChrW(&HED), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="i3", Replacement:=ChrW(&H1D0), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="i4", Replacement:=ChrW(&HEC), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="o1", Replacement:=ChrW(&H14D), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="o2", Replacement:=ChrW(&HF3), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="o3", Replacement:=ChrW(&H1D2), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="o4", Replacement:=ChrW(&HF2), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="u1", Replacement:=ChrW(&H16B), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="u2", Replacement:=ChrW(&HFA), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="u3", Replacement:=ChrW(&H1D4), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="u4", Replacement:=ChrW(&HF9), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="v1", Replacement:=ChrW(&H1D6), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="v2", Replacement:=ChrW(&H1D8), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="v3", Replacement:=ChrW(&H1DA), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="v4", Replacement:=ChrW(&H1DC), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True ' (b) Upper case. Selection.Replace What:="A1", Replacement:=ChrW(&H100), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="A2", Replacement:=ChrW(&HC1), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="A3", Replacement:=ChrW(&H1CD), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="A4", Replacement:=ChrW(&HC0), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="E1", Replacement:=ChrW(&H112), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="E2", Replacement:=ChrW(&HC9), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="E3", Replacement:=ChrW(&H11A), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="E4", Replacement:=ChrW(&HC8), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="I1", Replacement:=ChrW(&H12A), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="I2", Replacement:=ChrW(&HCD), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="I3", Replacement:=ChrW(&H1CF), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="I4", Replacement:=ChrW(&HCC), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="O1", Replacement:=ChrW(&H14C), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="O2", Replacement:=ChrW(&HD3), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="O3", Replacement:=ChrW(&H1D1), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="O4", Replacement:=ChrW(&HD2), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="U1", Replacement:=ChrW(&H16A), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="U2", Replacement:=ChrW(&HDA), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="U3", Replacement:=ChrW(&H1D3), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="U4", Replacement:=ChrW(&HD9), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="V1", Replacement:=ChrW(&H1D5), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="V2", Replacement:=ChrW(&H1D7), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="V3", Replacement:=ChrW(&H1D9), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True Selection.Replace What:="V4", Replacement:=ChrW(&H1DB), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=True ' ' (C) 2005, 2008 pinyinjoe.com ' End Sub Sub Pinyin_2_Current_Sheet() On Error Resume Next Dim s As Worksheet, s1 As Worksheet Dim rng As Range Set s1 = ActiveSheet Set rng = Selection s1.Select Cells.Select Pinyin_1_selected_cells If Not rng Is Nothing Then rng.Select End If End Sub Sub Pinyin_3_Entire_Workbook() On Error Resume Next Dim s As Worksheet, s1 As Worksheet Dim rng As Range Dim rng2 As Range Set s1 = ActiveSheet Set rng = Selection For Each s In ActiveWorkbook.Worksheets s.Activate Set rng2 = Selection s.Select Cells.Select Pinyin_1_selected_cells If Not rng2 Is Nothing Then rng2.Select End If Next s1.Activate If Not rng Is Nothing Then rng.Select End If ' Paste this macro carefully between the "Sub" and "End sub" lines. ' NAME THIS MACRO AS FOLLOWS: Pinyin_1_selected_cells() ' Name it by copying and paste that name EXACTLY after the word "Sub" above, ' erasing any other name you may have given this macro, OR ELSE THE ' WORKSHEET AND WORKBOOK VERIONS WILL NOT RUN. ' ' About this macro: ' ' Pinyin Joe 's Tone Mark Macro for Excel ' Version 1.0, released April 2008 ' Copyright (c) 2005-2008 pinyinjoe.com ' http://www.pinyinjoe.com ' ' Based on the algorithm in Pinyin Joe's Tone Mark Macro for Word. ' Code port from Word to Excel by Tushar Kapila, http://sel2in.com ' Further code and algorithm modification by Pinyin Joe, http://www.pinyinjoe.com ' FOR TECHNICAL SUPPORT, CONTACT: http://www.pinyinjoe.com/contact.htm '