質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.48%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

3回答

2808閲覧

vba(Excel) で bmp を出力したい(入力:セル範囲,倍率/出力:bmp)

退会済みユーザー

退会済みユーザー

総合スコア0

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2018/02/18 05:20

編集2018/02/18 11:00

問題:biSizeImageとbfSizeとファイル内容が違う
制限:
0. 追加ソフトは不可(使用環境の問題)
0. スクリーンショット不可(セル上のデータ構造の問題、CopyPictureを含む)

どこを説明したらいいかわからないので
説明の足りないところがありましたらその場所
を教えていただきたいです。

投稿できる長さを超えたので
入出力やコード、ファイル内容はこちらに公開しています。

正しい画像(拡大png版)
正しい画像(拡大png版・ペイントで用意した分析用ファイル)
まったく面影もない間違った画像(拡大png版)
まったく面影もない間違った画像(拡大png版・vbaによる出力ファイル)

nullの計算、詰め物の計算などが間違っていると思いますが
ステップイン実行しても出力はバイナリなのでウォッチウィンドウは
役立てにくく、突破口が見つかりません。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

unz.hori

2018/02/18 05:31

もう少し質問内容を具体的に書いてください。エラーが出るのか、出力されたbmpがおかしいのか等を
guest

回答3

0

bmpファイルの構造にはあまり詳しくなかったため、下記サイトさんを参考にしました。
⇒C言語による画像処理プログラミング

この情報をもとに、正しい画像のバイナリデータと見比べれば問題点が見つかると思います。

ヘッダ部

まずヘッダ部(54バイト)を見てみると、画像サイズは幅0x0E、高さ0x0Eつまり14x14となっていますが、このあたりは一致しています。
異なっているのはファイルサイズと画像サイズの部分です。

ファイルサイズ
正:9E 02 00 00
誤:CA 00 00 00

これもリトルエンディアンで書かれていますので、正解の方は0x029E、10進数では670という数字になっています。
この値の根拠を考えてみます。

ヘッダ部は54バイトなので、データ部は616バイトということになります。

14行x14列をカラーコード3バイトで表すので、単純計算では
14行 * 14列 * 3バイト = 588バイト
です。

しかし1行ごとに4の倍数のバイト数となるようにNULL(00)を補う必要があるので、
14行 * ((14列 * 3バイト) + 2バイト) = 616バイト
となるわけです。

今回、出力されているサイズの数値が異なっているようですので、まずはその計算を見直してはどうでしょうか。

データ部

次にデータ部を見てみます。

データ部は、画像の下の行から順に出力されています。
行の中では左から右にデータが並びます。

今回は7x7のデータを14x14として出力するため、各セルを行・列それぞれで2回ずつ出力しています。
ここまでは問題なさそうですが、1行が4の倍数となるように補う部分に問題がありそうです。

コード上では
Palette = Palette & WorksheetFunction.Rept(" 00 00", 4 - ((3 * arg.Columns.Count * zoom) Mod 4))
となっています。
上記で4 - ((3 * arg.Columns.Count * zoom) Mod 4)4 - ((3 * 7 * 2) Mod 4)で結果は2となります。
この結果、"00 00"を2回繰り返して"00 00 00 00"を付加しています。

今回補いたいのは(14列x3バイト)=42バイトを4で割った余り2バイト分の"00 00"なので、ここも修正が必要な個所かと思います。


これらを修正すれば、正しい画像が出力されると思います。
※私の環境でデータ部のロジックを修正し、出力された画像ファイルをバイナリエディタで正しいファイルサイズ・データサイズに書き換えてみたところ、正常な画像となりました。

頑張ってみてください。

コメントを受けて説明追記

今回、純粋に画像にしたいデータの1行分の長さは、7列 x 2倍 x 3バイト = 42バイトです。

式にすると
画像の実データ長(①) = x * zoom * 3
です。

これを画像ファイルにする際は1行を4の倍数に揃えたいので、4で割った余りの数を4から引いた数だけNULLを補完します。
必要なNULLの数は、42バイト を 4バイト で割った余り、2バイトを 4バイトから引いた値、2バイトです。

式にすると
NULLデータ長(z) = 4 - ((x * zoom * 3) mod 4)
です。

※ここ、わかりにくいですかね。
※例えば倍率が1の場合、 7 * 1 * 3 = 21バイトで、4で割った余りは1です。4の倍数にするためには4-1=3バイトのNULLが必要ということです。

画像データにする時の1行の長さは、画像の実データ長(①) + NULLデータ長(z)ですので、今回は 42バイト + 2バイト = 44バイトです。
式にすると
1行のデータ長(②) = (x * zoom * 3) + (4 - ((x * zoom * 3) mod 4))
です。


画像データ部のサイズは、1行のデータ長(②) * 行数 ですので、今回は 44バイト x 7行 x 2倍 = 616バイトです。
式にすると
画像データサイズ(③) = ((x * zoom * 3) + (4 - ((x * zoom * 3) mod 4))) * y * zoom
です。


最後に全体のファイルサイズは、ヘッダ部のサイズ(54バイト) + 画像データサイズ(③)ですので、今回は 54 + 616バイト = 670バイトです。
式にすると
全体のファイルサイズ(f) = 54 + (((x * zoom * 3) + (4 - ((x * zoom * 3) mod 4))) * y * zoom)
となります。


ご覧のとおり、Nullデータ長(z)は列数(x)と倍率(zoom)に依存するため固定値とはならず、最終的な計算式にも出現しません。

zの代わりに倍率zoomを要素とするなら、
f(x, y, zoom) = 54 + (((x * zoom * 3) + (4 - ((x * zoom * 3) mod 4))) * y * zoom)
という回答になります。

zoomを2倍と固定してf(x,y)で式にするなら
f(x, y) = 54 + (((x * 6) + (4 - ((x * 6) mod 4))) * y * 2)
です。

合計の式というよりは過程で求めた1行のバイト数やNULLバイト数が正しく算出できるか、というところが重要ですね。
上記も1行ですっきり書いてしまうよりは、過程の計算をそれぞれ変数に代入していった方が、結果がおかしいときに原因を探りやすくなると思います。

参考になれば幸いです。

投稿2018/02/19 05:26

編集2018/02/19 08:16
jawa

総合スコア3013

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2018/02/19 06:49

f(x,y,z)=x*((y*24/8)+z) =[@row]*(([@col]*24/8)+[@1行当たりの詰物]) をセルに入力し計算しましたが f(1,1,3)≠4となり正しい答えを導けません。 f(x,y,z)で表現するならこの関数はどういう式ですか? 以下の形式で答えていただきたいです。 f(x,y,z)=式
jawa

2018/02/19 08:15

いきなりx,y,zがでてきて混乱しましたが、f:ファイルサイズ、x:列数、y:行数、z:詰め物・・・NULLのバイト数ということであってますでしょうか? 作成された式も、どうも元の誤った式にひきずられているところがあるようですので、ひとまずはそれは忘れて、ひとつずつ冷静に考えたほうがよさそうです。 あと、いきなり全体を考えず、ひとつずつ整理しましょう。 回答本文とも一部重複する内容になりますが、もう少し掘り下げた解説を本文に追記させていただきます。 ややこしいところもありますので、わからないところがあればまたご質問ください。
退会済みユーザー

退会済みユーザー

2018/02/19 08:56 編集

すみません説明不足でした。 jawa さんと同じf()という関数で考えたので紛らわしくなりました。 jawa さんのf()と私が質問したf()は全く別のものです。 f(x,y,z)=biSizeImage 画像データサイズ[byte] x=biHeight 画像の高さ[ピクセル] y=biWidth 画像の幅[ピクセル] z=1行当たりの詰物
jawa

2018/02/19 09:33 編集

回答に記載したもので読み替えていただければよさそうですが、追記内容はご理解いただけたでしょうか? f(x,y,z)の形で式にするなら、 `f(x,y,z) = 54 + (((x * 3) + z) * y)` です。 zはカラーコードではないので3倍の対象ではない、というところが一応肝と言えるでしょうか。 そして今回それよりも重要になっているのが z = 4 - ((x * 3) mod 4) という式です。 これを先ほどの式に置き換えると f(x,y,z) = 54 + (((x * 3) + (4 - ((x * 3) mod 4))) * y) となります。 加えて、私の解説に記載したx,yは、excel上の行数・列数でした。 もともと提示いただいていたコードではr,cでしたね。 今回の式で、x,yをr,c,zoomで表現すると x = c * zoom y = r * zoom となります。 これも先ほどの式に置き換えると f(x,y,z) = 54 + (((c * zoom * 3) + (4 - ((c * zoom * 3) mod 4))) * r * zoom) となるわけです。 これは回答追記したものと同じ内容ですよね。 大事なのは「どんな式なのか?」ということよりも「その値はどういった意味なのか?」という部分だと思います。 画像データのサイズとは、ヘッダサイズ(54バイト)+画像データサイズです。 画像データサイズとは、縦サイズ*横サイズです。 横サイズとは、横のドット数x色情報(3バイト)+NULL補完です。 この仕組みが理解できれば、式はおのずと組みあがってきます。 がんばってみてください。
退会済みユーザー

退会済みユーザー

2018/02/19 12:44

縦(x=4),横(y=4),倍率(zoom=1)のとき NULLデータ長(z) = 4 - ((x * zoom * 3) mod 4) より z=4-((4 * 1 * 3) mod 4) =4-(12 mod 4) =4-0 =4 となりますが実際に4*4の白色bmpをペイントで作り バイナリエディタで見たところ 色情報の入っている36(HEX)~65(HEX)まですべてffで 埋められていました。 結局00の数を求める式がわからずコメントしました。
退会済みユーザー

退会済みユーザー

2018/02/19 13:59 編集

https://www.mm2d.net/main/prog/c/image_io-06.html でC言語を Excelワークシート関数で考えたところ =INT(([@col]*3+3)/4)*4*[@row] 以下参考の計算部抜出 stride = (img->width * 3 + 3) / 4 * 4; info->biSizeImage = stride *img->height;
jawa

2018/02/22 02:10

しばらくwebをみることができなくて返信遅くなりました。すみません。 >縦(x=4),横(y=4),倍率(zoom=1)のとき 確かにこの計算式だと割り切れるときに0個とならず4個出してしまいますね。 私も元の計算式に引きずられていたようです。申し訳ありませんでした。 >INT(([@col]*3+3)/4)*4*[@row] もとの計算方法は「実際の画像データ長」+「NULLデータ長」で計算していましたが、この方法は「NULL埋め後のあるべきデータ長」を求める方法ですね。 これも正解だと思います。 --- 画像サイズ計算は上記でよかったとして、解決済みコードの >Palette = Palette & WorksheetFunction.Rept(" 00", (arg.Columns.Count * zoom) Mod 4) の部分はこれで大丈夫でしたでしょうか? 余りが0と2の時は正しそうですが、1と3の時はNULLの個数を間違えているように思います。 既に解決済みですので、以降はあくまで参考案として記載させていただきます。 今回「NULLを埋める数」は「ファイルサイズの計算」「画像データサイズの計算」「NULL埋め処理」と少なくとも3回は使用します。 繰り返し使用する値ですので、それぞれの計算式の中で直接計算するよりも一度変数に代入しておいた方がわかりやすくなると思います。 同様に「1行のデータ長」や「画像データサイズ」も変数にした方が読み手が数字の根拠をつかみやすくなると思います。 ``` Dim lFileSize As long Dim lImageSize As long Dim lDataLine As long Dim iNulls As Integer '1行の画像データ長 lDataLine = c * zoom * 3 'NULL数の計算(1行が4の倍数になるよう調整) iNulls = 4 - (lDataLine Mod 4) If iNulls = 4 Then iNulls = 0 '4で割った余りが0の時はNULL不要 '画像データサイズ lImageSize = (lDataLine + iNulls) * (r * zoom) 'ファイルサイズ lFileSize = 54 + lImageSize ``` このコードで、NULL個数計算の部分は計算式とIf文の2段構えとなっています。 この部分、例えば`4 - (((lDataLine - 1) Mod 4) + 1)`とすれば1回で計算することもできます。 でも「なんで-1してから4で割った余りを求めてそこに+1?」ってなりますよね。 検証すればこれが「4で割った余りを0・1・2・3ではなく4・1・2・3で返すための仕組み」だとわかりますが直感的ではありません。 数式やコード・コメントなどは、読む人が直感的に意味が分かる内容であることも大切だと思いますので、今回はあえてわかりやすい2行にしてみました。 参考になれば幸いです。
退会済みユーザー

退会済みユーザー

2018/02/22 09:18

arg.Columns.Countが1の時 zoomを1から6の範囲で実行してみたところ NULLの数はペイントで作った場合と同じになりました。
ExcelVBAer

2018/02/22 09:36

横やり失礼しますが、FaberSid さん、回答者さんへの感謝の気持ちはありますか? 忙しい中、仕事の合間をぬって熱心に回答してくれている jawa さんではなく、 自分で自己解決したとして自分にベストアンサーを付けた事を jawa さんがどう感じるかを考えられますか?
退会済みユーザー

退会済みユーザー

2018/02/22 11:03

今まで考えたこともなかったです。 私趣味の範囲でしか(しかも気まぐれで)質問サイトをうろうろしていただけだったので この場を借りてお礼申し上げます。 ありがとうございました imihito さん jawa さん ExcelVBAer さん  (書き込み順)
jawa

2018/02/22 11:33 編集

>Palette = Palette & WorksheetFunction.Rept(" 00", (arg.Columns.Count * zoom) Mod 4) なるほど。 検証してみると確かに計算結果は正しくなりますね。 画像データには色情報として列数x「3倍」のデータが入るので、これが4の倍数に揃えるときの「割る数」よりも1小さい数だから成り立つ計算式だったんですね。 計算式からはなかなか辿り着かない理論(私だけ?^^;)ですので、できれば「数パターン試してみて実際のデータと一致したから」という理由ではなく、上記のような裏付けも記載していただけるとありがたかったです。 ともあれ、いらぬ危惧で大変失礼しました。 >ExcelVBAerさん 私としてはあまりBAにこだわりがなく、謎解き感覚で回答している部分もありますので、まず問題が解決すること、そしてそれを糧に今後に活用していただけることが第一だと思っています。 こう書くと聖人ぶって聞こえますね(^-^; お気遣いありがとうございます。
guest

0

ざっくりとしかコードを見てませんがまず一つ。
バイナリファイルはテキストファイルではありません
出力時はちゃんとByteに変換してあげてください。

(Byte配列化されているので、バイナリの形式の問題だと思われます)

また全部手実装するよりは、多少汚くても既存機能を使った方が楽です。

クリップボードを経由しますが、ExcelのVBAだけで完結する例

Excel Tips 選択範囲をJPEGで保存する

同じくクリップボード経由で、PowerShellを使って出力する例(Winodws 7以降ならPowerShellはプリインストール・色々加工したい場合用)

vba

1'srcRng :画像化したいセル範囲 2'savePath :保存先のパス 3Sub SaveRangeAsBmpByClipBoard( _ 4 srcRng As Excel.Range, _ 5 savePath As String) 6 7 Const PS_EXE = "Powershell.exe -Sta -NoProfile -Command " 8 Const PS_CMD = "Add-Type -AssemblyName System.Windows.Forms, System.Drawing;if([Windows.Forms.Clipboard]::ContainsImage()){[Windows.Forms.Clipboard]::GetImage().Save('保存先', 'Bmp')};" 9 10 Dim psExecCmd As String 11 psExecCmd = PS_EXE & VBA.Replace(PS_CMD, "保存先", savePath) 12 13 Call srcRng.Copy 14 Call VBA.Shell(psExecCmd, vbNormalFocus) 15 16End Sub

実行しているPowerShellのスクリプト

posh

1Add-Type -AssemblyName System.Windows.Forms, System.Drawing; 2if ([Windows.Forms.Clipboard]::ContainsImage()) { 3 [Windows.Forms.Clipboard]::GetImage().Save('保存先', 'Bmp') 4}
蛇足:Excelの選択範囲を画像化して保存するPowerShellスクリプト
# Excelの選択範囲を画像化して保存するスクリプト PowerShell ISE に張り付けて実行 $ErrorActionPreference = 'Stop' # bmpの保存先 [string]$savePath = [IO.Path]::Combine([Environment]::GetFolderPath('MyPictures'), 'pstmp.bmp') # 一セルあたり何ピクセルで表現するか [int]$zoom = 2 # Excelを取得 [__ComObject]$appXl = [Runtime.InteropServices.Marshal]::GetActiveObject('Excel.Application') [__ComObject]$srcRng = $appXl.Selection # 範囲の行数取得 [int]$rowCnt, [int]$colCnt = $srcRng.Rows.Count, $srcRng.Columns.Count # TODO:COM Release # 出力する画像をインスタンス [hashtable]$bmpArg = @{ TypeName = 'Drawing.Bitmap' ArgumentList = ($colCnt * $zoom), ($rowCnt * $zoom) } [Drawing.Bitmap]$bmp = New-Object @bmpArg # [Excel.Range].Interior.Color => [Drawing.Color] Function XlRGBtoDrawColor([int]$XlRGB) { return [Drawing.Color]::FromArgb( #もっと良い方法がありそう $XlRGB -band 0xFF, # Red ($XlRGB -band 0xFF00) / 0x100, # Green ($XlRGB -band 0xFF0000) / 0x10000 # Blue ) } # セル範囲ループ for ($r = 1 ; $r -le $rowCnt ; $r += 1) { for ($c = 1 ; $c -le $colCnt ; $c += 1) { [Drawing.Color]$drwClr = XlRGBtoDrawColor -XlRGB ($srcRng.Item($r , $c).Interior.Color) # TODO:COM Release # セル座標は1始まり、画像内座標は0始まり [int]$startX = ($c - 1) * $zoom [int]$startY = ($r - 1) * $zoom # zoom分塗りつぶしのループ もっと良い方法がありそう for($x = $startX ; $x -lt $startX + $zoom ; $x += 1) { for($y = $startY ; $y -lt $startY + $zoom ; $y += 1) { $bmp.SetPixel($x, $y, $drwClr) } } } } # COM解放(適当) [Runtime.InteropServices.Marshal]::FinalReleaseComObject($srcRng) > $null ; $srcRng = $null [Runtime.InteropServices.Marshal]::FinalReleaseComObject($appXl) > $null ; $appXl = $null # 保存 $bmp.Save($savePath, 'bmp') explorer "/select,$savePath"

投稿2018/02/18 06:32

編集2018/02/18 10:14
imihito

総合スコア2166

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2018/02/18 07:21

回答ありがとうございます。 ---------------------------------------------- BMP_binary()を呼び出した側で For i = 0 To UBound(s) b(i) = "&H" & s(i) Next をしていますが不適切なプログラムですか? ------------------------------------------------------ すみませんが、VBAの機能だけでさらにはセルの 色は取得するがセル内の色だけが必要なので(画像として) 図としてコピーし張り付ける方法は簡単ですが 今回は直接書き込む方法だけを探します。
imihito

2018/02/18 08:40

すみません。b()の宣言が離れていたのと、自動型変換に頼った書き方をしていたため見間違えました。 となると純粋にバイナリの形式のミスということになると思います。
guest

0

ベストアンサー

VBA

1'Microsoft Excel Objects>Sheet1 2Private Sub CommandButton3_Click() 3 Dim file As String 4 Dim i As Long 5 If 1 Then 6 file = Application.GetSaveAsFilename(ThisWorkbook.Path, _ 7 "ビットマップ,*.bmp;*.dib,JPEG,*.jpg;*.jpeg;*.jpe;*.jfif,GIF,*.gif,TIFF,*.tif;*.tiff,PNG,*.png") 8 End If 9 For i = 1 To Len(file) 10 If (Left(right(file, i), 1) = ".") Then Exit For 11 Next 12 If CStr(file) = "False" Then 13 MsgBox "キャンセルされました。", vbInformation 14 Exit Sub 15 End If 16 If right(file, 4) <> ".bmp" Then 17 MsgBox "現在、" & right(file, 4) & "はまだ実装されていません。", vbCritical 18 Exit Sub 19 End If 20 If Dir(CStr(file)) <> "" Then 21 If MsgBox(file & "は既に存在します。" & vbCrLf & "既存のファイルを上書きしますか?" _ 22 , vbExclamation + vbOKCancel, "名前を付けて保存") = vbCancel Then 23 Exit Sub 24 End If 25 Kill file 26 End If 27 Dim b() As Byte, s() As String 28 Dim fh, size As Integer 29 s = BMP_Binary(ThisWorkbook.Worksheets("DATA1").Range("B2:H8"), size, 2) 30 ReDim Preserve b(size - 1) 31 ReDim Preserve s(size - 1) 32 33 For i = 0 To size - 1 34 b(i) = "&H" & s(i) 35 Next 36 fh = FreeFile 37 Open file For Binary Access Write As #fh 38 Put #fh, , b 39 Close #fh 40End Sub 41'--------------------------------------------------------v 42'標準モジュール>image_binary 43Private Type BMP 44 H00 As String 'bfType 'As Integer 'ファイルタイプ 45 H02 As String 'bfSize 'As Long 'ファイルサイズ[byte] 46 H06 As String 'bfReserved1 'As Integer '予約領域1 47 H08 As String 'bfReserved2 'As Integer '予約領域2 48 H0A As String 'bfOffBits 'As Long 'ファイル先頭から画像データまでのオフセット[byte] 49 H0E As String 'biSize 'As Long '情報ヘッダサイズ[byte] 50 H12 As String 'biWidth 'As Long '画像の幅[ピクセル] 51 H16 As String 'biHeight 'As Long '画像の高さ[ピクセル] 52 H1A As String 'biPlanes 'As Integer 'プレーン数 53 H1C As String 'biBitCount 'As Integer '色ビット数[bit] 54 H1E As String 'biCompression 'As Long '圧縮形式 55 H22 As String 'biSizeImage 'As Long '画像データサイズ[byte] 56 H26 As String 'biXPixPerMeter 'As Long '水平解像度[dot/m] 57 H2A As String 'biYPixPerMeter 'As Long '垂直解像度[dot/m] 58 H2E As String 'biClrUsed 'As Long '格納パレット数[使用色数] 59 H32 As String 'biCirImportant 'As Long '重要色数 60End Type 61 62Function BMP_Binary(arg As Range, ByRef size, Optional zoom As Integer = 1) 63 Dim file As BMP 64 file.H00 = "42 4d": file.H06 = "00 00" 65 file.H08 = "00 00": file.H0A = 逆16進数(54, 4) 66 file.H0E = "28 00 00 00": file.H1A = "01 00" 67 file.H1C = 逆16進数(24, 2): file.H1E = "00 00 00 00" 68 file.H26 = "00 00 00 00": file.H2A = "00 00 00 00" 69 file.H2E = "00 00 00 00": file.H32 = "00 00 00 00" 70 71 Dim i 72 i = arg.Cells.Count * (zoom ^ 2) 73 size = 54 + Int((arg.Columns.Count * zoom * 3 + 3) / 4) * 4 * arg.Rows.Count * zoom 74 file.H02 = 逆16進数(54 + Int((arg.Columns.Count * zoom * 3 + 3) / 4) * 4 * arg.Rows.Count * zoom, 4) 75 file.H12 = 逆16進数(arg.Columns.Count * zoom, 4) 76 file.H16 = 逆16進数(arg.Rows.Count * zoom, 4) 77 file.H22 = 逆16進数(Int((arg.Columns.Count * zoom * 3 + 3) / 4) * 4 * arg.Rows.Count * zoom, 4) 78 79 Dim Palette As String 80 Dim r As Integer, c As Integer 81 Dim Pattern As Integer, cnt_R As Integer, cnt_c As Integer 82 83 For r = arg.row + arg.Rows.Count - 1 To arg.row Step -1 84 For cnt_R = 1 To zoom 85 For c = arg.Column To arg.Column + arg.Columns.Count - 1 86 For cnt_c = 1 To zoom 87 Pattern = 4 88 On Error Resume Next 89 Pattern = WorksheetFunction.Match(ThisWorkbook.Worksheets("DATA1").Cells(r, c), ThisWorkbook.Worksheets("DATA3").Range("A1:A5"), 0) - 1 90 On Error GoTo 0 91 Palette = Palette & " " & ThisWorkbook.Worksheets("DATA3").Range("C1").Offset(Pattern) 92 Next 93 Next 94 Palette = Palette & WorksheetFunction.Rept(" 00", (arg.Columns.Count * zoom) Mod 4) 95 Next 96 Next 97 Palette = Mid(Palette, 2) 98 99 100 101 102 Dim data() As String 103 ReDim data(54 + Int((arg.Columns.Count * zoom * 3 + 3) / 4) * 4 * arg.Rows.Count * zoom - 1) 104 105 With file 106 data = Split(UCase(xl_CONCATENATE(" ", .H00, .H02, .H06, .H08, .H0A, .H0E, .H12, .H16, .H1A, .H1C, .H1E, .H22, .H26, .H2A, .H2E, .H32, Palette)), " ") 107 End With 108 BMP_Binary = data 109End Function 110 111Private Function 逆16進数(num10 As Integer, num As Integer) 112 Dim i As Integer 113 Dim num16 As String 114 Dim str() As String 115 ReDim str(num) 116 num16 = WorksheetFunction.Rept("00", num) & WorksheetFunction.Base(num10, 16) 117 For i = 0 To num - 1 118 逆16進数 = 逆16進数 & Mid(num16, Len(num16) - 1 - i * 2, 2) 119 If i < num - 1 Then 逆16進数 = 逆16進数 & " " 120 Next 121End Function 122 123Private Function xl_CONCATENATE(Delimiter As String, ParamArray str()) 124 Dim s 125 For Each s In str 126 xl_CONCATENATE = xl_CONCATENATE & Delimiter & CStr(s) 127 Next 128 xl_CONCATENATE = Mid(xl_CONCATENATE, Len(Delimiter) + 1) 129End Function 130

ありがとうございました
imihito さん
jawa さん
ExcelVBAer さん
(書き込み順)

投稿2018/02/19 16:13

編集2018/02/22 11:04
退会済みユーザー

退会済みユーザー

総合スコア0

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.48%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問