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分量值。但是lor不⼀定代表真实的颜⾊值。具体情况如下:
当我选中某些字符后，打开字体对话框，选择字体颜⾊下拉框中“主题颜⾊”的某种颜⾊后，再通过代码lor获取刚才所设置的字符颜⾊，发现值是⼀个⾮常⼤的负数，选择不同的主题颜⾊对应不同的值，此值与具体颜⾊⽆关，如-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
resize函数vba.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
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论