|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
给表格上色
Sub cellssize() '标准化表格大小
For i = 1 To 1600 Step 1
With Sheet7.cells(1, i)
.ColumnWidth = Application.CentimetersToPoints(0.1875 / 1)
End With
Next
For i = 1 To 900 Step 1
With Sheet7.cells(i, 1)
.RowHeight = Application.CentimetersToPoints(0.1875 * 5.3007518 * 1.04 / 1)
End With
Next
End Sub
Sub setcolor()
For ii = 900 To 1 Step -1
For j = 1 To 1600 Step 1
'从第55个字节开始,每个像素三个字节
'xs = 字符数据(ddd) & 字符数据(ddd + 1) & 字符数据(ddd + 2)
string1 = ThisWorkbook.Worksheets("图像二进制数据矩阵").cells(ii, j)
datelong = Len(ThisWorkbook.Worksheets("图像二进制数据矩阵").cells(ii, j))
If datelong > 4 Then
bb = Mid(string1, 1, datelong - 4)
gg = Mid(string1, datelong - 4 + 1, 2)
rr = Mid(string1, datelong - 2 + 1, 2)
End If
If datelong = 4 Then
bb = 0
gg = Mid(string1, datelong - 4 + 1, 2)
rr = Mid(string1, datelong - 2 + 1, 2)
End If
If datelong = 3 Then
bb = 0
gg = Mid(string1, 1, 1)
rr = Mid(string1, datelong - 2 + 1, 2)
End If
If datelong <= 2 Then
bb = 0
gg = 0
rr = string1
End If
If datelong = 0 Then
bb = 0
gg = 0
rr = 0
End If
bb = Application.WorksheetFunction.Hex2Dec(bb)
gg = Application.WorksheetFunction.Hex2Dec(gg)
rr = Application.WorksheetFunction.Hex2Dec(rr)
ThisWorkbook.Worksheets("图像二进制数据矩阵").cells(ii, j).Interior.Color = RGB(rr, gg, bb)
'ddd = ddd + 3
Next j
Next ii
End Sub |
|