Function DEX2HEX(dec, places)
Dim hexarr(16) As String
hexarr(0) = "0"
hexarr(1) = "1"
hexarr(2) = "2"
hexarr(3) = "3"
hexarr(4) = "4"
hexarr(5) = "5"
hexarr(6) = "6"
hexarr(7) = "7"
hexarr(8) = "8"
hexarr(9) = "9"
hexarr(10) = "A"
hexarr(11) = "B"
hexarr(12) = "C"
hexarr(13) = "D"
hexarr(14) = "E"
hexarr(15) = "F"
Dim result As String
Dim tmp As Long
tmp = dec
For i = 1 To places Step 1
j = tmp Mod 16
tmp = tmp / 16
'If tmp < 16 Then
'result = "0" & result
'Else
result = Trim(hexarr(j)) & Trim(result)
'End If
Next i
DEX2HEX = result
End Function
Sub showFonts()
'
' 宏3 Macro
' spd-jxliu 记录的宏 2007-3-20
'
' 0x9401(37889) --0xfad9(64217)
Dim num, code As Long
Dim NameA, NameB, NameC, NameD, FileBig5, FileGb, FileKsc As String
Dim unicode As String
code = 22007
For num = 2 To 65536 Step 1
rowstr = Trim(Str(num)) & ":1"
Rows(rowstr).RowHeight = 34
unicode = DEX2HEX(code, 4)
NameA = "A" & Trim(Str(num))
Range(NameA).Select
Selection.NumberFormatLocal = "@"
ActiveCell.Value = unicode
NameB = "B" & Trim(Str(num))
Range(NameB).Select
FileGBF = "C:/fonts/KH76字库/新增10个字中间Unicode码1/位图/16bmp1/" & unicode & ".bmp"
havegbf = Dir(FileGBF)
If (havegbf <> "") Then
ActiveSheet.Pictures.Insert(FileGBF).Select
Selection.ShapeRange.Height = 32
Selection.ShapeRange.Width = 32
Selection.ShapeRange.IncrementLeft 5
Selection.ShapeRange.IncrementTop 1
End If
' NameC = "C" & Trim(Str(num))
' Range(NameC).Select
' FileJPNF = "D:/test/JAP_first/161/Ux_" & unicode & ".bmp"
' havejpnf = Dir(FileJPNF)
' If (havejpnf <> "") Then
' ActiveSheet.Pictures.Insert(FileJPNF).Select
' Selection.ShapeRange.Height = 32
' Selection.ShapeRange.Width = 32
' Selection.ShapeRange.IncrementLeft 5
' Selection.ShapeRange.IncrementTop 1
' End If
If (havegbf = "" And havejpnf = "") Then
num = num - 1
End If
code = code + 1
If code > 41000 Then
ActiveWorkbook.Save
Exit For
End If
' If num Mod 1000 = 0 Then
' ActiveWorkbook.Save
' End If
Next num
End Sub
将bmp位图贴到excel中的一段VB代码
最新推荐文章于 2024-08-18 22:36:54 发布