|
在浏览自己系统里带有的COM组件时,看到了WIA.ImageFile.1 这个网上查了下,了解到这个组件可以对图片做些处理。具体能做些图片格式转换,像素处理,剪切之类的工作。这个组件Win7应该是自带的。
我用他写了个宏,将图片转换为Excel单元格拼接的马赛克图片。下面是代码。图片最好256色的。
- Public Const scrHeight = 435
- Public Const scrWidth = 124
- Public Const RC = 8
- Public objBMPData, objScreen, Screen
- Public bitRowCount, bitColCount, allLine
- Public bits()
- Sub LoadingPicture()
- '' 初始化显示屏幕
- Call ReadBMPData
- Call SetConfig
- Call ClearScreen
- Call RefreshScreen
- End Sub
- Sub ReadBMPData()
- Dim file
- Set dlgOpen = Application.FileDialog(3)
- If dlgOpen.Show = -1 Then
- file = dlgOpen.SelectedItems(1)
- Else
- End
- End If
-
- Set pic = CreateObject("WIA.ImageFile.1")
- pic.LoadFile file
- bitColCount = pic.Width
- bitRowCount = pic.Height
- bitDepth = pic.PixelDepth
- Set cl = pic.ARGBData
- ReDim bits(bitRowCount, bitColCount)
- Index = 1
- For i = 0 To bitRowCount - 1
- For j = 0 To bitColCount - 1
- bits(i, j) = cl.Item(Index)
- Index = Index + 1
- Next
- Next
- End Sub
- Sub SetConfig()
- Set Screen = Sheets("屏幕")
- Set objScreen = Screen.Range("A2").Resize(bitRowCount, bitColCount)
- Screen.Cells.ColumnWidth = scrWidth / bitColCount
- Screen.Range("2:50000").RowHeight = scrWidth * RC / bitColCount
- End Sub
- Sub RefreshScreen()
- Application.ScreenUpdating = False
- For i = 0 To bitRowCount - 1
- For j = 0 To bitColCount - 1
- objScreen.Cells(i + 1, j + 1).Interior.Color = bits(i, j)
- Next
- Next
- Application.ScreenUpdating = True
- End Sub
- Sub ClearScreen()
- Screen.Cells.Clear
- End Sub
复制代码 |
|