Question

我在MS Word（2016）中有1到7位数的表（从1到数百万），我需要所有的，数千和数百万将是绿色，数十，数千 - 蓝色和数百和成千上万 - 红色。你可以帮我用vba脚本吗？

Sub creatable()

Dim docNew As Document
Dim tableNew As Table
Dim celltable As Cell

Dim X As Integer
Dim y As Integer
Dim cnt As Integer
Dim Rndm As Long
Dim a As Long
Dim b As Long
 Dim celTable As Cell
 Dim intCount As Integer
 Dim intChar As Integer


a = CInt((Rnd() + 1) * (Int((2025 * Rnd()) + 1)))
b = CInt((Rnd() + 1) * (Int((4355 * Rnd()) + 1)))
Rndm = a + b

Set docNew = Documents.Add
Set tableNew = docNew.Tables.Add(Selection.Range, 6, 12)

For y = 1 To 12
With tableNew
  .Cell(X, y).Range.InsertAfter Rndm * X
  End With
 For X = 1 To 6
  With tableNew
  .Cell(X, y).Range.InsertAfter Rndm * y
  End With
Next
Next

 For Each celTable In tableNew.Range.Cells
 intChar = celTable.Range.Characters.Count
If celTable.Range.Characters.Count = 1 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 End If
 If celTable.Range.Characters.Count = 2 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 End If
 If celTable.Range.Characters.Count = 3 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 End If
 If celTable.Range.Characters.Count = 4 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 End If
 If celTable.Range.Characters.Count = 5 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 End If
 If celTable.Range.Characters.Count = 6 Then
celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 6).Font.ColorIndex = wdRed
 End If
 If celTable.Range.Characters.Count = 7 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 6).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 7).Font.ColorIndex = wdGreen
 End If

 intCount = intCount + 1

 Next celTable

End Sub

This is how it should look at the end

Answer 1

发现解决方案（不完美，但至少有效）：

Sub creatable()

Dim docNew As Document
Dim tableNew As Table
Dim celltable As Cell

Dim X As Integer
Dim y As Integer
Dim cnt As Integer
Dim Rndm As Long
Dim a As Long
Dim b As Long
 Dim celTable As Cell
 Dim intCount As Integer
 Dim intChar As Integer


a = CInt((Rnd() + 1) * (Int((2025 * Rnd()) + 1)))
b = CInt((Rnd() + 1) * (Int((4355 * Rnd()) + 1)))
Rndm = a + b

Set docNew = Documents.Add
Set tableNew = docNew.Tables.Add(Selection.Range, 6, 12)

For y = 1 To 12
With tableNew
  .Cell(X, y).Range.InsertAfter Rndm * X
  End With
 For X = 1 To 6
  With tableNew
  .Cell(X, y).Range.InsertAfter Rndm * y
  End With
Next
Next

 For Each celTable In tableNew.Range.Cells
 intChar = celTable.Range.Characters.Count
  If celTable.Range.Characters.Count = 1 Then
     celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
   End If
   On Error Resume Next
  If celTable.Range.Characters.Count = 2 Then
     celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
     celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
   End If
  If celTable.Range.Characters.Count = 3 Then
     celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
     celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
    celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 End If
 On Error Resume Next
 If celTable.Range.Characters.Count = 4 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 End If
 On Error Resume Next
 If celTable.Range.Characters.Count = 5 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 End If
 On Error Resume Next
 If celTable.Range.Characters.Count = 6 Then
celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 6).Font.ColorIndex = wdRed
 End If
 On Error Resume Next
 If celTable.Range.Characters.Count = 7 Then
 celTable.Range.Characters(intChar - 1).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 2).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 3).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 4).Font.ColorIndex = wdGreen
 celTable.Range.Characters(intChar - 5).Font.ColorIndex = wdBlue
 celTable.Range.Characters(intChar - 6).Font.ColorIndex = wdRed
 celTable.Range.Characters(intChar - 7).Font.ColorIndex = wdGreen
 End If
 On Error Resume Next
 intCount = intCount + 1

 Next celTable

End Sub

在特定位置更改角色的颜色

1 个答案: