VBA宏以突出显示当前电子邮件中的选定文本

时间:2013-12-17 01:30:19

标签: vba outlook-2013

我正在尝试为Outlook 2013创建一个VBA宏,它将在我当前正在编写的电子邮件中采用所选文本(采用HTML格式)并设置字体大小/颜色/粗体/突出显示。

我的宏有两个if / then块。一个块用于Outlook 2003,并为所有四个文本特征提供所需的结果。但是,在2003年之后,Outlook使用Word EditorType来处理HTML电子邮件,因此我需要一个具有不同语法的不同VBA块来更改所选文本的字体。我的2013块中的VBA可以正确地用于更改粗体/磅值,但它不会对文本应用突出显示。相反,突出显示文本的命令(rng.Range.HighlightColorIndex = wdYellow)导致选择窗口的背景颜色变为清除(因此即使仍然真正选择了文本,也不再显示文本) ,但没有突出显示应用于所选文本。

当突出显示文字不起作用时,我尝试了别的东西。我尝试使用vba命令将背景设置为黄色(当没有vba手动应用时,它具有相同的视觉效果)。 rng.Shading.BackgroundPatternColor = wdColorYellow。但是,背景变为黑色,而不是将背景变为黄色。

2013块也不会导致字体颜色发生变化。尽管语句(rng.Font.Color = wdColorBlue)

,字体颜色仍保持黑色

请告诉我如何将所选文本突出显示为黄色,并将所选文本的颜色设置为蓝色。

完整的VBA宏位于下方。

 Sub ChangeSelectedFontBold14HiYellow()
 Dim msg As Outlook.MailItem
 Dim insp As Outlook.Inspector

 Set insp = Application.ActiveInspector

 If insp.CurrentItem.Class = olMail Then 
     Set msg = insp.CurrentItem

     If insp.EditorType = olEditorHTML Then ' outlook 2003
         Set hed = msg.GetInspector.HTMLEditor
         Set rng = hed.Selection.createRange
         rng.pasteHTML "<b><font style='color: blue; background: yellow; font-size: 14pt;'>" & rng.Text & "</font></b>"
     End If

     If insp.EditorType = olEditorWord Then ' outlook 2013
         Set hed = msg.GetInspector.WordEditor
         Set word = hed.Application
         Set rng = word.Selection
         rng.Font.Size = 14
         rng.Font.Color = wdColorBlue ' color does not change
         rng.Font.Bold = True
         ' rng.Shading.BackgroundPatternColor = wdColorYellow ' changes background color to black instead of yellow
         ' rng.HighlightColorIndex = wdYellow ' does not work  ' error 438 object doesn't support this property
         rng.Range.HighlightColorIndex = wdYellow ' does not work - changes the background to clear for the selection indicator color

     End If

 End If
 Set insp = Nothing
 Set rng = Nothing
 Set hed = Nothing
 Set msg = Nothing
 End Sub

1 个答案:

答案 0 :(得分:5)

您需要向Word对象库添加VBA项目引用,或者定义这些常量,以便Outlook可以了解wdColorBluewdYellow的真实值。

当我这样做时,您的代码具有所需的效果(但如果您添加引用,那么您不能使用Word作为变量名称)

这对我有用(或多或少 - 我在测试时工作,但现在不在......) Collapse部分在Word中运行正常,因此 也可以在Outlook中运行。

Sub ChangeSelectedFontBold14HiYellow()
 Dim msg As Outlook.MailItem
 Dim insp As Outlook.Inspector

 Set insp = Application.ActiveInspector

 If insp.CurrentItem.Class = olMail Then 
     Set msg = insp.CurrentItem

     If insp.EditorType = olEditorHTML Then ' outlook 2003
         Set hed = msg.GetInspector.HTMLEditor
         Set rng = hed.Selection.createRange
         rng.pasteHTML "<b><font style='color: blue; background: yellow; font-size: 14pt;'>" & rng.Text & "</font></b>"
     End If

     If insp.EditorType = olEditorWord Then ' outlook 2013
         Set hed = msg.GetInspector.WordEditor
         Set appWord = hed.Application
         Set rng = appWord.Selection
         rng.Font.Size = 14
         rng.Font.Color = wdColorBlue 
         rng.Font.Bold = True
         rng.Range.HighlightColorIndex = wdYellow

         rng.Collapse Direction:=wdCollapseEnd 'UNTESTED, but something like this...
     End If

 End If

 Set appWord = Nothing
 Set insp = Nothing
 Set rng = Nothing
 Set hed = Nothing
 Set msg = Nothing

 End Sub