画像をエクセルで処理できないか

質問

エクセルで画像変換は簡単にできますが、逆ができません。
具体的には、
たくさんの色が入った画像データがあります。
これをエクセルに変換し、A1は赤色、A2は青色、B1は黄色、B2は白色などと元にもどしたいと思っています。
そんなことはできないものでしょうか。どうかよろしくお願いします。

回答No.6

mitarashi · ベストアンサー

#5で用いている関数です。参考URLのコードを参考にさせていただきました。
Function getIndexColor(myColorIndex As Long) As myRGB
Dim ColorHex As String
Dim j as long

ColorHex=Hex(ActiveWorkbook.Colors(myColorIndex))
For j=0 To 5-Len(ColorHex)
ColorHex="0" & ColorHex
Next
With getIndexColor
.blue=CLng("&H" & Left(ColorHex,2))
.green=CLng("&H" & Right(Left((ColorHex,4),2))
.red=CLng("&H" & Right(ColorHex,2))
End With
End Function

ついでに画像をセルに読込。56色対応。パレットを書換えます。色数指定で減色できるFreeSoftで前処理してから読込むとそこそこ見られます。
Sub convertImageToCell()
Dim clGdip As clgdiplus
Dim retBool As Boolean
Dim lPixels() As Byte
Dim lCptX As Long, lCptY As Long
Dim colorRed As Long, colorGreen As Long, colorBlue As Long
Dim dic As Object
Dim myKey As String
Dim colorCounter As Long
Const srcfile As String = "C:\test.bmp"

Set clGdip = New clgdiplus
Set dic = CreateObject("Scripting.Dictionary")
retBool = clGdip.OpenFile(srcfile)
lPixels = clGdip.GetPixels
For lCptX = 1 To UBound(lPixels(), 2)
For lCptY = 1 To UBound(lPixels(), 3)
colorBlue = lPixels(1, lCptX, lCptY)
colorGreen = lPixels(2, lCptX, lCptY)
colorRed = lPixels(3, lCptX, lCptY)
myKey = CStr(colorRed) & "(白星)" & CStr(colorGreen) & "(白星)" & CStr(colorBlue)
If Not dic.exists(myKey) Then
colorCounter = colorCounter + 1
If colorCounter <= 56 Then
dic.Add myKey, colorCounter
ActiveWorkbook.Colors(colorCounter) = RGB(colorRed, colorGreen, colorBlue)
End If
End If
Cells(lCptY, lCptX).Interior.ColorIndex = dic.item(myKey)
Next lCptY
Next lCptX
Set dic = Nothing
Set clGdip = Nothing
End Sub

参考URL：

http://pygj.cocolog-nifty.com/mukago/excel_vba/index.html

回答No.7

mitarashi

#3-6です。#6中、（白星）となっているところは、いわゆる特殊文字になるのでしょうか？星のマークが書き換えられてしまったものです。リニューアル前は通ったんですけどね。
ここは適当な区切り文字を使ってください。

お礼

ご回答ありがとうございました。
大変丁寧におしえていただいたのですが、私の技量がとても追いつきません。まずマクロにどの部分をどのように貼り付けたらよいのかさえわかりません。助けてださる方がいらっしゃるのに残念で仕方がありません。申し訳ありません。

回答No.5

mitarashi

#3です。2K文字弱を投稿しようとすると、「アクセス集中」のエラーが出て、数日来出来ませんでした。そこで、短いのを#4で投稿してみると、久しぶりに通りました。という訳で、小分けに投稿してみます。
Type myRGB
red As Long
green As Long
blue As Long
End Type

Sub convertCellToImage()
Dim clGdip As clGDIplus
Dim retBool As Boolean
Dim lPixels() As Byte
Dim lCptX As Long, lCptY As Long
Dim xoffset As Long, yoffset As Long
Dim myCellColor As myRGB
Dim destfile As String
Dim ImageWidth As Long, ImageHeight As Long
Dim vntFileName As Variant
Dim pictType As String
Const jpegQuality As Long=90

If TypeName(Selection)<>"Range" Then Exit Sub
ImageWidth=Selection.Columns.count
ImageHeight=Selection.Rows.count
xoffset=Selection.Cells(1).Column-1
yoffset=Selection.Cells(1).Row-1
vntFileName=Application.GetSaveAsFilename(InitialFileName:="picture.jpg" _
, FileFilter:="画像ファイル,*.jpg;*.bmp",FilterIndex:=1,Title:="保存先の指定")
If vntFileName <> False Then
Select Case StrConv(Right(vntFileName,3),vbUpperCase)
Case "JPG"
pictType="JPG"
Case "BMP"
pictType="BMP"
Case Else
MsgBox "Error"
Exit Sub
End Select
destfile=vntFileName
Else
Exit Sub
End If
Set clGdip=New clGDIplus
retBool=clGdip.CreateBitmap(ImageWidth,ImageHeight,96)
lPixels=clGdip.GetPixels
For lCptX=1 To UBound(lPixels(),2)
For lCptY=1 To UBound(lPixels(),3)
myCellColor=getIndexColor(Cells(lCptY+ yoffset,lCptX+xoffset).Interior.ColorIndex)
With myCellColor
lPixels(1,lCptX,lCptY)=.blue
lPixels(2,lCptX,lCptY)=.green
lPixels(3,lCptX,lCptY)=.red
lPixels(4,lCptX,lCptY)=0
End With
Next lCptY
Next lCptX
clGdip.SetPixels lPixels
If pictType="JPG" Then
retBool=clGdip.SaveFile(destfile,"JPG",jpegQuality)
Else
retBool=clGdip.SaveFile(destfile,pictType)
End If
Set clGdip=Nothing
End Sub

回答No.4

mitarashi

#3です。新版をダウンロードして使ってみました。
1.Le module clGdiPlus au format txt pour toutes versions d'Office.v1.5 (06/12/09)をDLします。
2.解凍するとclGdiPlus.txtというのが出来ます。この拡張子をclsに変えてもmoduleにインポートされてしまうので、
3.VBEで挿入/クラスモジュールでクラスを作成し、名前をclGdiPlusに変更します。
4.上記のテキストファイルをクラスモジュールにコピペします。
5.クラスの最初の方の、#Const Access = TrueをFalseに変更します。
これで問題なく動作いたしました。

選択セルの各セルを画素として、ビットマップとして保存するのをやってみましたので、別途投稿します。

回答No.3

mitarashi

「エクセルで」できる範疇に入るかどうか分かりませんが、VBAからGDI+を使えば画像処理ができます。flatAPIを使うのは、日本語の情報が少なく大変ですが、参照URLで、AccessVBAから使用できるクラスが紹介されています。ソースは自由にみられます（コメントはフランス語で文字化けしますが．．．）
紹介してくれている、UTANGさんの日本語訳リファレンスの参考コードをアレンジさせていただくと、下記の様なコードで、画素別の色を操作できました。
http://www.f3.dion.ne.jp/~element/msaccess/AcTipsFrmGdiClass.html
ただし、自分が使用したのは2007非対応の前バージョンで、クラス内の、Private gCtrlRef As Controlのところを、MSForms.Controlに変更して、Micorosoft Forms 2.0 objective libraryに参照設定しないと、エクセルVBAではエラーになりました。（変更箇所が、きちんと動くかどうかは未検証）
試しに、画素の色を読み取ってセルに着色してみましたが、当方が使用しているXL2000（56色）では惨めな事になりました。2007（1677万色）なら良いのでしょうね。
clgdiplus.clsをインポートする必要があります。
Sub test()
Dim srcFile As String, destFile As String
Dim clGdip As clgdiplus
Dim imageObject As Object
Dim retBool As Boolean
' ピクセル色成分を受け取る配列
Dim lPixels() As Byte
' カウンタ
Dim lCptX As Long, lCptY As Long
Dim colorRed As Long, colorGreen As Long, colorBlue As Long

Set clGdip = New clgdiplus
srcFile = "C:\Documents and Settings\?????\test1.jpg"
destFile = "C:\Documents and Settings\?????\test2.jpg"
' ファイルを開く
retBool = clGdip.OpenFile(srcFile)
' ピクセル色成分を配列に取得
lPixels = clGdip.GetPixels
' ピクセル単位でループ
For lCptX = 1 To UBound(lPixels(), 2)
For lCptY = 1 To UBound(lPixels(), 3)
' 赤の色成分だけ残し、青と緑の色成分を 0 に変更します
' 青の色成分を削除
lPixels(1, lCptX, lCptY) = 0
' 緑の色成分を削除
lPixels(2, lCptX, lCptY) = 0
' 色成分 青 = lPixels(1, lCptX, lCptY)
' 色成分 緑 = lPixels(2, lCptX, lCptY)
' 色成分 赤 = lPixels(3, lCptX, lCptY)
' 色成分 不透明度 = lPixels(4, lCptX, lCptY)
Next
Next
' 画像の色成分を設定
clGdip.SetPixels lPixels
retBool = clGdip.SaveFile(destFile, "JPG")
Set clGdip = Nothing
End Sub
「回答する」ボタンを押そうとして間違って「投票」してしまいました。すみませんでした。

回答No.2

koko88okok

クリップアートのMWFファイルであれば可能で、次のように操作します。

1) 右クリックから「グループ化」をポイントし、「グループ解除」をクリックします。
2) 「これはインポートされた図で、・・・」のメッセージに「はい」を押します。
3) 前記、1)を繰り返しますと、オートシェイプの「グループ解除」後と同じ状態になります。

なお、オートシェイプをコピーして「形式を選択して貼り付け」から「図(拡張メタファイル)」または「図(Windowsメタファイル)」を指定して貼り付けた図でも、上記と同じ操作で分解することができます。

お試し下さい。

お礼

ご回答をありがとうございました。
やってみたのですが、うまくいきません。
どうもわたしの説明が悪かったようです。
まず、図をコピペできません。

回答No.1

noname#194317

Excel単体だと、VBAからAPIを呼び出すなど、面倒な処理になります。簡単にやれる方法はないと思います。おそらく専用の別プログラムを用意して、そいつにcsv出力させる方が、同じ作るにしても楽なんじゃないでしょうか？どこかにそういった画像処理用のOCXでもあればいいんですが、フリー見つけるのは厳しそうな気が…

あともう一つ問題があって、幅が256ドットよりも大きい画像を処理するには、Excelも2007かより新しいバージョンが必要です。というのは、古いExcelでは列数の上限が256しかないからです。ということは、画像を縮小するか、あるいはドットをいくつか置きに飛ばして読むしかないですよね。

お礼

ご回答いただきありがとうございました。
久しぶりにHPを開いたら、みなさんから多くの回答をいたいていたことがわかり恐縮しています。