因此,我正在努力为某些人创建文档,其中每个组(其中有三个组)被分配给文档的输入字体颜色。我编写了一个VBA脚本,其中包含每个参与其中的列表,并且可以识别登录计算机及其组的人。但是,我无法获得字体颜色来设置自己。我录制了一个vba脚本,在其中设置字体颜色以查看单词的作用,但是由此产生的代码 Selection.Font.Color = wdColorRed 当我将其添加到VBA脚本中时,实际上不会更改选定的字体颜色。这是我正在使用的代码的示例:

Private Sub Document_Open()

Dim Users As New Scripting.Dictionary
Dim UserID As String
Dim category As String

UserID = GetUserName 'Currently using the example at
                     'http://support.microsoft.com/kb/161394 as a function

'---Add Members of Group 1---
Users.Add "person1", "group1"
Users.Add "person2", "group1"

'---Add Members of Group 2---
Users.Add "person3", "group2"
Users.Add "person4", "group2"
Users.Add "person5", "group2"

'---Add Members of Group 3---
Users.Add "person6", "group3"
Users.Add "person7", "group3"

For Each user In Users.Keys
    If user = UserID Then
        If Users.Item(user) = "group1" Then
            Selection.Font.Color = wdColorRed
        ElseIf Users.Item(user) = "group2" Then
            Selection.Font.Color = wdColorGreen
        ElseIf Users.Item(user) = "group3" Then
            Selection.Font.Color = wdColorBlue
        Else
            Selection.Font.Color = wdColorBlack
        End If
    End If
Next

End Sub
有帮助吗?

解决方案

AFAIK,您无法为特定用户设置默认字体颜色。即使您设法将其设置为蓝色,并且导航到红色的句子,如果您键入任何内容,您也不会看到蓝色文字而是红色文本。因为光标的位置将选择用于为该句子着色的原始颜色。

要为用户设置特定颜色,您要么必须要么

  1. Identify a range and set the color for it. 。但是,就像我上面提到的那样,如果用户导航到另一个范围,那么新的颜色设置将不应用于那里。

  2. Set it for the entire document. 。如果将其设置为整个文档,则整个文档的颜色将会更改,我相信这不是您想要的。

其他提示

可能的解决方法基础 Application.WindowSelectionChange Event. 。因此,您需要保留以下步骤:

1.创建类模块
2.名称您的班级模块 App
3.将以下代码添加到 App Class Module:

    Public WithEvents WRD As Application

    Private Sub WRD_WindowSelectionChange(ByVal Sel As Selection)
        'here you should place solution from your Document_Open sub
        'which defines color based on user name or...
        'you could place it somewhere else but pass color value 
        'here as a parameter

        'for test I just assumed that color should be blue
        Sel.Font.Color = wdColorBlue
    End Sub

4.在标准模块添加公共变量:

    Public tmpApp As New App

5.在标准模块中创建子,或在您的 Document_Open Event, ,这将初始化我们的班级:

Sub Document_Open_new()

    Set tmpApp.WRD = Application

    'we need to change selection once to trigger full
    'scope of solution
    'if we omit the code below new color will not work
    'if user add new text at the beginning of the document
    'right after it was opened
    Dim tmpSel As Range
    Set tmpSel = Selection.Range
    ActiveDocument.Bookmarks("\EndOfDoc").Select
    tmpSel.Select
End Sub

6.如果将代码添加到 Document_open event.

- -编辑 - - (在下面@SID的一些评论之后)

使用建议的解决方案有一些不便。但是,大多数可以通过添加一些来解决 If statements 里面 WindowSelectionChange event. 。检查位置 Sel range 参数,周围的文本和其他内容允许精确确定是否应应用新颜色。

许可以下: CC-BY-SA归因
不隶属于 StackOverflow
scroll top