|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
HHAAMM 发表于 2009-2-25 04:06 
Sub 图片文件的数据保存到EXCEL的A列中()
Dim arr() As Byte, H&, x&
Open "d:\1.jpg" For Binary As #1
...
将楼上的代码稍作改动,以方便自已调用:
Sub 将图片转换为数组()
Dim fn, f
Dim arr() As Byte, H, i
fn = Application.GetOpenFilename("图像文件,*.jpg", , "请选文件", , MultiSelect:=True)
If Not IsArray(fn) Then Exit Sub
For Each f In fn
Open f For Binary As #1
H = LOF(1)
ReDim arr(1 To H)
Get #1, , arr
Close #1
For i = 1 To UBound(arr)
Cells(i, 1) = arr(i)
Next i
Next
End Sub
Sub 从EXCEL的A列提取数据生成图片()
Dim arr() As Byte, a&, x&
a = Range("a65536").End(xlUp).Row
ReDim arr(1 To a)
For x = 1 To a
arr(x) = Range("a" & x)
Next
Open ThisWorkbook.Path & "\1.jpg" For Binary As #1
Put #1, , arr
Close #1
Dim myObj As Shape
For Each myObj In ActiveSheet.Shapes
If myObj.Name Like "Rectangle*" Then myObj.Select
Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\1.jpg"
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.DeleteFile (ActiveWorkbook.Path & "\1.jpg")
End Sub
|
|