Word批量加注拼音/清除拼音

lss001 · 发表于 2020-2-5 14:02

本帖最后由 lss001 于 2020-2-14 23:06 编辑

Sub WordjzPY() 'Word批量加注拼音

On Error Resume Next

Selection.WholeStory

Selection.Font.Size = CByte(22) '设置字体大小

TextLength = Selection.Characters.Count

Selection.EndKey

For i = TextLength To 0 Step -30

If i <= 30 Then

Selection.MoveLeft Unit:=wdCharacter, Count:=i

SelectText = Selection.MoveRight(Unit:=wdCharacter, Count:=i,Extend:=wdExtend)

Else

Selection.MoveLeft Unit:=wdCharacter, Count:=30

SelectText = Selection.MoveRight(Unit:=wdCharacter, Count:=30,Extend:=wdExtend)

End If

SendKeys "{Enter}"

Application.Run "FormatPhoneticGuide"

'Application.Dialogs(wdDialogPhoneticGuide).Show '986

Selection.Font.Size = CByte(11) '返回字体大小

End Sub

Sub WordqcPY() 'Word批量清除拼音

'Line:

Application.ScreenUpdating = False

Selection.WholeStory

TextLength = Selection.Characters.Count

Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1

For i = 0 To TextLength

With Selection

.Range.PhoneticGuide Text:="", _

Alignment:=wdPhoneticGuideAlignmentOneTwoOne, _

Raise:=11, FontSize:=8, FontName:="MS Gothic"

End With

Selection.MoveRight Unit:=wdCharacter, Count:=1

'If Selection.Characters.Count > TextLength Then GoTo Line

Application.ScreenUpdating = True

End Sub

shenjianrong163 · 发表于 2020-2-14 15:57

将字体设大后，拼音怎样调整呢?

weiyingde · 发表于 2020-2-14 22:27

谢谢分享，只可惜拼音的字体太小，用代码该如何调整？

lss001 · 发表于 2020-2-14 22:30

本帖最后由 lss001 于 2020-2-14 23:03 编辑

weiyingde 发表于 2020-2-14 22:27
谢谢分享，只可惜拼音的字体太小，用代码该如何调整？

Selection.Font.Size = CByte(22) '字体大小，1楼已经更正！

lss001 · 发表于 2020-2-14 23:04

shenjianrong163 发表于 2020-2-14 15:57
将字体设大后，拼音怎样调整呢?

参考楼上更正代码！

liuxi001 · 发表于 2020-2-15 01:35

大神，再写一个PPT版本滴~

lss001 · 发表于 2020-3-29 09:20

本帖最后由 lss001 于 2020-3-29 12:13 编辑

'更新代码以调整字号/偏移量
Sub WordjzPY()
On Error Resume Next
Application.DisplayAlerts = False
Selection.WholeStory
Selection.Font.Size = CByte(11)
TextLength = Selection.Characters.Count
Selection.EndKey
For i = TextLength To 0 Step -30
      If i <= 30 Then
         Selection.MoveLeft Unit:=wdCharacter, Count:=i
         SelectText = Selection.MoveRight _
         (Unit:=wdCharacter, Count:=i, Extend:=wdExtend)
      Else
         Selection.MoveLeft Unit:=wdCharacter, Count:=30
         SelectText = Selection.MoveRight _
         (Unit:=wdCharacter, Count:=30, Extend:=wdExtend)
      End If
      SendKeys "{Enter}"
      Application.Run "FormatPhoneticGuide"
      'Application.Dialogs(986).Show
Next
ActiveDocument.Fields.ToggleShowCodes
Selection.WholeStory
With Selection.Find
      .Text = "hps11 " '调整字号
      .Replacement.Text = "hps20 "
      .Execute Replace:=wdReplaceAll
      .Text = "up 10" '调整偏移量
      .Replacement.Text = "up 15"
      .Execute Replace:=wdReplaceAll
End With
ActiveDocument.Fields.ToggleShowCodes
x = Selection.GoTo(wdGoToPage, GoToNext, 1).Start
Application.DisplayAlerts = True
End Sub

dongxy1996 · 发表于 2020-5-18 15:07

大神：书名号和引号的内容不能加拼音，能否修改。谢谢

cai2532 · 发表于 2024-3-10 23:51

厉害学习了。

caisl · 发表于 2024-3-22 12:39

太牛了，有多音字的能否加个选择？

		自动登录	找回密码
密码			免费注册

[分享] Word批量加注拼音/清除拼音

评分