VBA基础九:画表格线及表外线的颜色定义

原表

 

 

目标统计汇总表

 

 VBA代码

Private Sub CommandButton1_Click()
Dim arr, i&, n&, d As Object, s$, a()
arr = Sheet1.Range("A1").CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For i = 3 To UBound(arr)
s = arr(i, 7) & "|" & arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5)
If Not d.Exists(s) Then
n = n + 1: ReDim Preserve a(1 To 12, 1 To n)
d(s) = arr(i, 6)
a(1, n) = arr(i, 2) '名称
a(2, n) = arr(i, 7) '材质
a(3, n) = arr(i, 3) '长
a(4, n) = arr(i, 4) '宽
a(5, n) = arr(i, 5) '厚
Else
d.Item(s) = d.Item(s) + arr(i, 6)
End If
Next
Sheet3.Range("A5:L10000").ClearContents
Sheet3.Range("A5:L10000").Borders.LineStyle = xlNone
If n = 0 Then Exit Sub
Sheet3.Range("A5").Resize(d.Count, UBound(a)) = WorksheetFunction.Transpose(a)
Sheet3.Range("G5").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.items)
Sheet3.Range("A5").Resize(d.Count, 12).Borders.LineStyle = xlContinuous
End Sub

运行后的效果

 

 

指定起点和止点,画线,上色

Sub DrawLine(StartX As Variant, StartY As Variant, EndX As Variant, EndY As Variant)
ActiveSheet.Shapes.AddLine(StartX, StartY, EndX, EndY).Select
Selection.ShapeRange.Line.Weight = 2
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End Sub

Sub lqxs()
Dim ks, js, shp As Shape, a, b, a1, a2, b1, b2, x1, y1, x2
For Each shp In Sheet1.Shapes
If shp.Type = 9 Then shp.Delete
Next
ks = Range("a1").Value: js = Range("b1").Value
a = ks * 24: b = js * 24
a1 = Int(a): a2 = a - a1
b1 = Int(b): b2 = b - b1
x1 = Cells(4, a1 - 5).Left + Cells(4, a1 - 5).Width * a2: y1 = Cells(4, a1 - 5).Top + Cells(4, a1 - 5).Height * 0.5
x2 = Cells(4, b1 - 5).Left + Cells(4, b1 - 5).Width * b2
DrawLine x1, y1, x2, y1
Range("a1").Select
End Sub

 

前景色:表外面的线条及颜色:

红色:.Color = -16776961。兰色:.Color = -4165632。黑色:.Color = -16250872。

背景色:.Interior.Color

Sheet3.Range("E3:F6").Interior.Color = 69000 '紫红色色块E3:F6,背景

 

索引色:rng.Interior.ColorIndex = 3,这里的3代表红色

为了减轻难度,直接把 color改为.ColorIndex=下面这56个编号中的一个就OK了。

 

分量颜色值:非常大的负数。看起来难以接受,原理是色号代码的二进制如#CCC,然后转成二进制数字。就成了如下这样的大数据。为了减轻难度,直接把 color改为.ColorIndex=上面这56个编号中的一个就OK了。

在进行基于word2007的二次开发,需要取字符的颜色值,进而得到颜色的RGB分量值。但是font.color不一定代表真实的颜色值。具体情况如下:
当我选中某些字符后,打开字体对话框,选择字体颜色下拉框中“主题颜色”的某种颜色后,再通过代码font.color获取刚才所设置的字符颜色,发现值是一个非常大的负数,选择不同的主题颜色对应不同的值,此值与具体颜色无关,如-587137025,-671023105,-738131969等。真实的颜色值是24位的,上述负值超出此范围。这不是真实的颜色值,我猜这是主题颜色表中的索引号,我想问可否将上述索引号映射为真实的颜色值或者其RGB分量。

 

Private Sub CommandButton3_Click()
Range("D2:G" & [G65536].End(xlUp).Row).Font.Color = -16776961 '从D列2行到G列有内容的区域行,定义色块红色字
End Sub

 

Sub Macro1()
For mycolumn= 1 To 100
For myrow= 2 To 5
' 从第1行到100行,vba的下标从1 开始,非传统的0开始
' 从第2列到第5列

ActiveSheet.Cells(myrow, mycolumn).Select
' 选中循环中的单元格
If ActiveCell.Value = "" Then
Else
With ActiveCell.Characters(Start:=1, Length:=0).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=1, Length:=8).Font
' 1~8字符 设置为红色
.Name = "宋体"
.FontStyle = "常规"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=9, Length:=1).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=10, Length:=5).Font
' 10~14字符 设置为深蓝色
.Name = "宋体"
.FontStyle = "常规"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -4165632
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Selection.Font.Bold = True
End If
Next
Next

End Sub

Private Sub CommandButton4_Click()
Sheet3.Range("E3:F6").Interior.Color = 69000 '紫红色色块E3:F6,背景
End Sub

posted @ 2020-07-16 14:28  袁氏家谱网  阅读(10)  评论(5编辑  收藏