Excel2003で作成したファイルをセル１つずつ単体で画像ファイルに保存したい

#1 です。ちょいと長いですが。。。 0.　C:\images フォルダを予め作成しておく 1.　[Alt]+[F11] で VBE を開く 2.　[挿入]-[標準モジュール] 3.　下記のソースコードをコピペ 4.　VBE を閉じる 5.　適当なセルにデータを入力し、そのセルを飛び飛びでも良いので 　　選択してから、[ツール]-[マクロ]-[マクロ]で実行 BMP（ビットマップ）ならこんな感じ。Jpeg や Gif でも書き出せるけど 少し複雑になります。 細かなエラー処理はしてません。 ' // ソースコードはここから下 Option Explicit ' // 標準モジュール ' // Declareations -------------------------------------------------- Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" ( _ 　　　　ByVal wFormat As Long) As Long Private Declare Function OpenClipboard Lib "user32.dll" ( _ 　　　　ByVal hWnd As Long) As Long Private Declare Function GetClipboardData Lib "user32.dll" ( _ 　　　　ByVal wFormat As Long) As Long Private Declare Function CloseClipboard Lib "user32.dll" () As Long Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _ 　　　　ByRef lpPictDesc As PictDesc, _ 　　　　ByRef RefIID As GUID, _ 　　　　ByVal fPictureOwnsHandle As Long, _ 　　　　ByRef IPic As IPicture) As Long ' // Types ---------------------------------------------------------- Private Type PictDesc 　　　　cbSizeofStruct As Long 　　　　picType　　　　As Long 　　　　hImage　　　　 As Long 　　　　Option1　　　　As Long 　　　　Option2　　　　As Long End Type Private Type GUID 　　　　Data1　　　　　As Long 　　　　Data2　　　　　As Integer 　　　　Data3　　　　　As Integer 　　　　Data4(7)　　　 As Byte End Type ' // Constants ------------------------------------------------------ Private Const CF_BITMAP　　　As Long = 2 Private Const CF_PALETTE　　 As Long = 9 ' // ここがメイン処理部 Sub セルごとにビットマップで書き出し() 　　Dim r　　　 As Range 　　Dim sImgDir As String 　　Dim lImgCnt As Long 　　Dim p　　　 As IPicture 　　 　　' // 画像の保存フォルダパス 　　sImgDir = "C:\images" 　　 　　' // 終了条件:: 選択されているのがセル以外なら無視 　　If UCase$(TypeName(Selection)) <> "RANGE" Then Exit Sub 　　 　　lImgCnt = 1 　　For Each r In Selection.Cells 　　　　' // ビットマップとしてクリップボードへコピー 　　　　r.CopyPicture Appearance:=xlScreen, _ 　　　　　　　　　　　Format:=xlBitmap 　　　　' // クリップボードのビットマップを Picture オブジェクトに変換 　　　　Set p = CreatePictureFromClipboard() 　　　　If Not p Is Nothing Then 　　　　　　' // BMPファイルを書き出す 　　　　　　Call SavePicture(p, sImgDir & "\image" & Format$(lImgCnt, "00000") & ".bmp") 　　　　　　lImgCnt = lImgCnt + 1 　　　　　　Set p = Nothing 　　　　End If 　　Next 　　' // フォルダを開く 　　Shell "explorer.exe " & Chr(34) & sImgDir & Chr(34), vbNormalFocus 　　 End Sub ' // クリップボードのビットマップデータから Picture オブジェクトを作成 Private Function CreatePictureFromClipboard() As IPicture 　 　　Dim hBitmap　　　 As Long 　　Dim hPalette　　　As Long 　　Dim uPic　　　　　As PictDesc 　　Dim IID_IDispatch As GUID 　　Dim lRet　　　　　As Long 　　 　　Set CreatePictureFromClipboard = Nothing 　 　　' 終了条件:: クリップボードに該当データが無い 　　If IsClipboardFormatAvailable(CF_BITMAP) = 0& Then Exit Function 　　' 終了条件:: クリップボードからイメージハンドルが取得できない 　　If OpenClipboard(0&) <> 0& Then 　　　　hBitmap = GetClipboardData(CF_BITMAP) 　　　　hPalette = GetClipboardData(CF_PALETTE) 　　　　Call CloseClipboard 　　End If 　　If hBitmap = 0& Then Exit Function 　 　　With uPic 　　　　.cbSizeofStruct = Len(uPic) 　　　　.picType = 1 　　　　.hImage = hBitmap 　　　　.Option1 = hPalette 　　End With 　　With IID_IDispatch 　　　　.Data1 = &H20400 　　　　.Data4(0) = &HC0 　　　　.Data4(7) = &H46 　　End With 　　lRet = OleCreatePictureIndirect(uPic, _ 　　　　　　　　　　　　　　　　　　IID_IDispatch, _ 　　　　　　　　　　　　　　　　　　0&, _ 　　　　　　　　　　　　　　　　　　CreatePictureFromClipboard) End Function