[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAを使用して、BMPの画像を自動トリミングってできるんでしょうか？？』（りりちゃん☆彡）
こんばんわ。
りりちゃん☆彡と申します。
いつもお世話になっております。
会社で、フリーソフトなどを勝手にインストールするのが禁止の為、とても困っているので、もしもご存知の方がいらっしゃったら教えてください。
シート内にBMP画像を複数枚挿入して、その画像を一気に
自動でトリミングしてほしいです。
そんな事ってできるんでしょうか？？
もしもご存知の方がいらっしゃったら教えてほしいです。
ちなみに、切り取りは四角枠で、全部同じ座標から切取りして大丈夫です。
難しそうな場合はあきらめて、会社から支給されたの画像処理ソフトで一つ一つ頑張ります( ;∀;)
他にも、良い方法をご存知の方がいらっしゃいましたら
アドバスよろしくお願い致します。
＜ 使用 Excel：Excel2010、使用 OS：Windows8 ＞
（γ） 2016/11/23(水) 21:46
以下のようなことを説明いただくと、回答側にとっても、二度手間がなくなり、回答が付きやすいと思います。
・複数の画像は、どのように 選ぶ？ 選択ダイアログで、これとこれとこれ というように選択？ 特定のフォルダ内のBMP画像をすべて対象にする？
・対象画像は大きさもマチマチだと思いますが、それを、どのようにシートに配置する？
・【全部同じ座標から切取り】というところを、もう少し明確にされてはいかがですか？ 上下左右、●ポイントを取り除く とか、縦横、それぞれ □%の長さを取り除く とか。
（β） 2016/11/24(木) 09:42
Sub test()
Shapes.SelectAll
With Selection.ShapeRange.PictureFormat
.CropLeft = 10
.CropRight = 20
.CropTop = 30
.CropBottom = 40
End With
End Sub
ですが、この方法だと切り取ったように見せているだけであり、元画像はそのままなんですよね。
（だから、それぞれの指定を0にすると、元に戻る）
フォトショ辺りのバッチ処理で、貼る前に画像データ自体を切り取っておくという手もあり。
（???） 2016/11/24(木) 11:45
この度は、書込みありがとうございます。
りりちゃん☆彡です。
いつもお世話になっております。
この度は、お忙しい所色々とありがとうございます。
昨日書込みした時は、VBAを使用してトリミングってできるのかな？と思ったため
それだけ聞いたつもりでいたので、不足している部分の多く色々と混乱させてしまって
どうもすみません。
さて、せっかくご質問頂きましたのでお答致したく思います。
（γ）様から頂いた、トリミングが必要な理由について。
画像にのっている数値をエクセル入力し、グラフを作成しております。
データー画像なので、BMPでしか出て来ません。
左側に数値などが入っており、右側はその数値の図という構成です。
グラフを作成する時はこの画像3枚でやっと一つのグラフになります。
右側の図の方は、最後PP資料になります。
色々やる事が多いので、一気にトリミングできたらいいのにと思って聞きました。
?A複数の画像は、どのように 選ぶ？ 選択ダイアログで、これとこれとこれ というように選択？
特定のフォルダ内のBMP画像をすべて対象にする？
３枚で一つの資料に使う感じなので、3枚づつかかな？？と思っていましたが。。
特定フォルダ内全部読込できた方がいいかなとも思います。
?B対象画像は大きさもマチマチだと思いますが、それを、どのようにシートに配置する？
画像の大きさは、みな同じ大きさです。
半分にトリミングできたららくかも？と思ってました。
見た感じが半分になればOKかなとも思ってます。切り取ったように見せているだけでOKかと。。大変だし。
いちおう、上から下方向にずら〜と並んでもらって
画像下にファイル名があったら。。とは思ってましたが。。
?C【全部同じ座標から切取り】というところを、もう少し明確にされてはいかがですか？
座標は、Xが、17.286で、Yが、231.383
です。
上下左右、●ポイントを取り除く とか、縦横、それぞれ □%の長さを取り除く とか。
?Dフォトショバッチに関して
会社にあるのがフォトショップなのですが、、使わないでやる方法をと言われてしまい困ってしまってます。
今は、仕方なくエクセル上でやっていますが、不便です。。
私も、フォトショでバッチの方がいいのでは？と思って調べたのですが、
使わない方法と言われたから困ってしまったんですね。。
バッチはこれまでにやったことないですが、フォトショ自体は趣味レベルですが使用経験ありなので。。
これを使った方がいいのにと本当は言ってやりたいくらいなんですよね・・。
?Eコードについて
コードは色々探してあったので、写真を一気とりこみできたんです。
とりあえず、今回はトリミングできるかどうかの可否としては難しいのかな？？という印象なので。。
ちょっとあきらめようかなと思っている所です。。
できませんっと伝えようと思います。
色々とお騒がせ致しました。
あと、（β）様コードありがとございました。いつもありがとう。ごめんね。。(..)
（りりちゃん☆彡） 2016/11/24(木) 22:11
背景はわかりました。
ところで、サンプルコードを提供してくださったのは ??? さんですよ。
（β） 2016/11/24(木) 23:03
今回は、いったんペンディングということですから、これで手じまいということで、 以下は、単なるサンプルです。
同じ大きさのBMP画像を シートの好きな場所に３枚挿入しておいて以下を実行すると 左半分をカットしたものを、３枚あわせた形で B2 に表示します。
こんな合成でいいなら、あとは、これを、どうフォルダから抽出するか、どうシートに挿入するか、 一緒にする３枚をどのように紐付けするか、そのあたりを加味すれば、なんとなくイメージに近い処理ができるかもですね。
Sub Sample()
Dim i As Long
Dim L As Double
Dim T As Double
With Range("B2")
L = .Left
T = .Top
End With
For i = 1 To 3
With ActiveSheet.Shapes(i)
.PictureFormat.CropLeft = .Width / 2
.Left = L
.Top = T
L = L + .Width
End With
Next
End Sub
（β） 2016/11/24(木) 23:19
んと、無知なので、教えてください。
PP資料のPPってなんですか？
で本題。
一気には拘らなくていいですよね？
ボタン押下で後は自動で処理してくれれば、方法は問わないかと？
３０分かかろうが１時間かかろうが、手動よりは確実に速くなるわけですから。
そのうえ間違いがない（はず）
繰返しの処理はコンピューターは大得意なので、
まずは、1つだけ自動で出来るか考えてみましょう。
あとは繰り返すだけなので。。。
で、やりたいことは、
元のbtm形式のファイルが１つあったとして、
それを、
「表部分とグラフ部分に分けた画像を作りたい」
ってことですか？で、３枚一組になるってことですか？
＞画像3枚でやっと一つのグラフになります。
僕の中で、画像とグラフがどうしてもつながりません。
エクセルが出てきたり、入力が出てきたり、図だったり、グラフだったり、
エクセルを使わなくても出来そうだけど、エクセルを使いたそうだったり、
話しがよくわかりません。
トリミングという言葉もたくさん出て来てるのですが、
エクセルの表の一部を図として保存したり、
グラフを図として保存したりしたいのかなぁと、
思うけど、エクセルを使わなくても出来そうなので、
訳が解りません。
元の画像が1つだったら、
どうしたいのが正解ですか？
（まっつわん） 2016/11/25(金) 07:55
＞昨日書込みした時は、VBAを使用してトリミングってできるのかな？と思ったため
＞ それだけ聞いたつもりでいたので
できますよ。
「エクセルＶＢＡ トリミング」でネットを検索すると いくらもヒットします。
???さんのコードでもできるはずです。
なぜ、できないと判断されたのか分かりませんが、
できませんっと伝えられるのは賛成です。
コメントを拝見する限り、りりちゃん☆彡さんはまだ、たにんさまに使っていただくものを
作るのはまだ早いのではないかと思います。
お仕事忙しくて、ほかにマクロ化するものはたくさんあるようですから、
本件はもっと経験値を上げてからでよろしいのではないですか。
（ 佳 ） 2016/11/25(金) 13:23
昨日コード教えてくＤ去ってありがとうございました。
すみません、（β） さんと間違えてしまってました。
大変申し訳ありません。
どうかこれにこりずにまた、ご指導いただけたら嬉しいです。
教えてくださっていた、AddPictureを探してみようかなっておもいます。
教えてくださってありがとうございます。
今後ともどうぞよろしくお願い致します。
それと。。。
せっかく色々聞いて下さっている方がいらっしゃるので御好意に甘える形ですが、
イメージ図作ってみました。
少しは分かりやすくなっているとよいのですが。。
色々お忙しい中、コメントなど頂きありがとうございました。
お時間があればどうぞご覧ください。
http://ww10.puny.jp/uploader/download/1480080993.bmp
pass:riri
昨日書きこみした内容が、皆様に上手に伝わればいいのですが。
とりあえず、、丸1が数値です。
これは、Aの画像ですが、A,B,Cが1つでグラフが一つできる感じになるので、
A部分の枠みたいになっている辺りで切り取って３枚を並べてそれを数字打ちすれば楽かも？と
思ったのでトリムできないかな〜？って思いました。
丸2の部分はその計測を図で示したものです。
これも切り取ってPP資料に貼ります。
丸3は使用しないので特に何もありません。
（β） さん、コードありがとうございました！！
スゴイですね。あんなふうにもできるんだ！うわってすごいっ( *´艸｀)て感動しちゃいました。
さすがです。。りりには到底出来そうにないです( ;∀;)
りりにはできそうにないけど。早々諦めることもなかったかしら。。
などとちょびっと思いました(*^^*)
まだ上司には言っていないので、諦めたこと知らないけどね(*'▽')
（まっつわん）様
PP資料は、パワーポイントで作成している、この件に関する資料です。
グラフをエクセルで作って貼りこみしたり、画像を切り抜いたりしていちいちめんどくさいですが
作成しています。
（ 佳 ） 様
そうですね。もっと勉強し直ししてからの方が良さそうです。
（りりちゃん☆彡） 2016/11/25(金) 23:00
イメージ拝見
この３だけ（あるいは ２と３だけ？）を切り取りたいということでしょうか。
あくまで、部品というか、参考コードですが。
まず、これら画像をいくつか（３つでも６つでも）シートに貼り付けてください。
で、その中の１つを選択。図ツールの書式タブが表示されますのでそれをクリック。 でてきたリボンの右のほうに トリミング というところがありますのでクリック。 そうすると選んだ画像のまわりにトリミング用の線が表示されますね。 この線を動かして、必要な部分だけ残します。
このあと、そのトリミングした画像を選んだ状態で、以下の トリム実行 を実行してください。 他の画像も、このトリミングにあわせて自動で一括トリミングをします。 おまけで 元に戻す を実行すると、トリミング前の状態になります。
Sub トリム実行()
Dim cropL As Double
Dim cropR As Double
Dim cropT As Double
Dim cropB As Double
Dim pic As Picture
With Selection.ShapeRange(1).PictureFormat
cropL = .CropLeft
cropT = .CropTop
cropR = .CropRight
cropB = .CropBottom
End With
For Each pic In ActiveSheet.Pictures
With pic.ShapeRange(1).PictureFormat
.CropLeft = cropL
.CropRight = cropR
.CropTop = cropT
.CropBottom = cropB
End With
Next
End Sub
Sub 元に戻す()
Dim pic As Picture
For Each pic In ActiveSheet.Pictures
With pic.ShapeRange(1).PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
Next
End Sub
（β） 2016/11/25(金) 23:45
あぁ、パワーポイントでしたか。。。。
イメージみました。
が、、、、、あれは編集完成後？それとも挿入する図？どっちですか？
できれば、ビフォーアフターで提示していただくとありがたいです。
たぶん編集完了後だろうということでコメントします。
なんか「トリミング」という言葉とは違う作業イメージかなと思うのですが。。。。
2）のところに、既存の画像ファイルを挿入して、
1）のところに、数値を手で入力
3）のところは、入力に追随してグラフが描写される
で、これらをひっくるめて1つの画像ファイルとして保存出来たらいいのかな？
画像で保存しなくても、リンクで上手くパワーポイントにデータ渡せないですかね。。。
パワーポイントを使ったことないので。。。。＾＾；
ってか、シートをスライドの代わりに使うのはまずいですか。。。。？
（なんでもエクセルで完結しようかと＾＾；）
（まっつわん） 2016/11/26(土) 08:44
いつもお世話になっております。
りりちゃん☆彡です。
この度もまたまたおてを煩わせてしまって本当にすみません。
（β）様、
お忙しい中コードありがとうございました！！
またまた超超、、、超感動しましたっ( *´艸｀)
スゴイねぇ〜、一気にできちゃうんだもん最初へっ？マジっ？ってまじまじ見ちゃった。
それにしても本当にスゴイねぇ〜。魔法使い見たい。
だって、ちらっと手を加えたらあら不思議全部同じになっちゃうのよぉ〜。^m^
ほんとに、本当に、本当にっどうもありがとうございますっ。
エクセルで、こんな風にできちゃうなんて。。思っても見なかったよりり。
もしも近くに住んでいらっしゃるなら弟子入り＋食事ぐらいごちそうしちゃいたい気分♪
これぜひぜひ使って頑張ってみるっ。(*´ε`*)
なんかやる気わいてきちゃったなぁ〜るん(^^♪
またいつもながら、、わかってないりりだけど。。
せっかく書いて下さったコードのあれこれをちょびっと教えてもらいたいですが。。図々しすぎだよね。
だって甘えっぱなしだもん。お世話になりすぎよね。
だから、、、自分で頑張って解読してみる(..)自信ないけど( ;∀;)
本当にどうもありがとうございましたっ(*^^)v
（まっつわん）様
こんばんわ。りりです。
エクセルで資料用グラフなどのデーターを作成、その後PP資料が一番最後になります。
せっかくビフォア―アフターのリクエストを下さったので、またまた作ってみました。
実際のものとはかけ離れている位可愛い系で作りましたが、本物はもっと会社風のものですのでご安心を。。
画像トリムの件は、（β）さんが、素敵すぎるコードを教えてくださったの(*^^*)で、
サクサクと悲しすぎる開いたり閉じたり作業もすることなく進みそうな予感。
きゃぁ〜〜うれしぃ〜〜(*´▽｀*)
という訳で、資料イメージ、せっかく作ったのでお手すきの際にでもご覧ください。
（β）様、（まっつわん）様、他ご覧いただきご指導を頂いた皆様、
お手すきの際にでもどうぞご覧くださいませ。
資料イメージ
http://ww10.puny.jp/uploader/download/1480168300.zip
pass: riri2
（β）様、
この度も本当にどうもありがとうございましたっ。
☆（ゝω・）vｷｬﾋﾟ
（りりちゃん☆彡） 2016/11/26(土) 23:04
今回のテーマを通じて、遊びながら、βも、いろんなことが発見できました。 そういう意味では感謝です。
アップしたコード、簡単にメモしておきますね。
その前に、最初に ??? さんがコメントしておられるように、エクセル上の画像のトリミングは その画像の左を何ポイントカットする、右を何ポイントカットする、上を何ポイントカットする、下を何ポイントカットするという情報を与えます。 それらの情報は、シェープの中のPictureFormatという箱の中の CropLeft 、CropRight、CropTop、CripBottom という封筒におさめられています。 ですから、切り取りたいポイント数を切り取りたい封筒にいれてやれば、それがカットされます。カット後の画像は、確かにカットされて小さいサイズになりますが でも、???さんがレスされた通り、それら部分は、本当に無くなったわけではなく、実態としては存在するけど、縦横とも長さゼロになって、見えていないだけ。 なので、それら封筒に 0 という値を入れてやると、カット部分は、ゼロ ということになって、元の画像に戻ります。
●Sample
With Range("B2")
L = .Left
T = .Top
End With
これからセットする図の左端の位置を L、上辺の位置を T という変数でコントロールしますが、 初期値として、LをB2セルの左端、TをB2セルの上辺の位置にしておきます。
For i = 1 To 3
With ActiveSheet.Shapes(i)
.PictureFormat.CropLeft = .Width / 2
.Left = L
.Top = T
L = L + .Width
End With
Next
i は 1 から 3 の値でループ。 ですから ActiveSheet.Shapes(i) は シート上の1番目の図、2番目の図、3番目の図 というように繰り返し処理をされますが その図のPictureSormatのCropLeftという封筒に その図の横幅（Width)の半分の長さをいれることで、左半分が切り取られてなくなります。 こうして 横半分のサイズになったこの図を 図のセット位置、L と T に 持っていきます。 （図の中に Left や Top という封筒があります。これらは、その図の左端の場所、上端の場所という意味です）
で、セットしたら、次の図の左端を、セットした図の右端にあわせるために、L を 今のLに今セットした図の横幅（Width)を加えたものにします。
●トリム実行
With Selection.ShapeRange(1).PictureFormat
cropL = .CropLeft
cropT = .CropTop
cropR = .CropRight
cropB = .CropBottom
End With
トリミングした図を選択して実行しますから、Selection は その図（実際にはその図のなかの Picture というオブジェクト）です。 Selection.ShapeRange(1).PictureFormat これは Selection.ShapeRange.PictureFormat でもいいのですが、前述の通り この選択された図の PictureFormat情報です。この中の切り取り情報（これも前述）として トリム結果が格納されていますので それを 変数に取り出しています。
For Each pic In ActiveSheet.Pictures
With pic.ShapeRange(1).PictureFormat
.CropLeft = cropL
.CropRight = cropR
.CropTop = cropT
.CropBottom = cropB
End With
Next
ここは、ちょっと 初心者コードでした。 ??? さんがアップされたコードのように、ループなしで、一括変更ができます。 でも、アップ済みの初心者コードで、申し上げますと、シート上の各図をループで取り出しながら、その切り取り情報に 最初に選択された図から抽出しておいた値をいれます。これで、すべての図が、最初に選択されていた図と同じ切り取り状態になります。
●元に戻す
For Each pic In ActiveSheet.Pictures
With pic.ShapeRange(1).PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
Next
ここも初心者コードでループ処理をしていますが、ループなしで一括処理できるところでしたね。 トリム実行では、図の切り取り情報の封筒に切り取り値をいれましたけど、ここでは 0 をいれています。 前述したように、0 を与えると、切り取られて見えなくなっていたところが復活します。
（β） 2016/11/27(日) 00:26
手間取らせてすみません。
解ったことと、やっぱり解らないことがあります。
解った（と、思う）のは、
トリミングというのは、画像の整形をしたいのではなく、
シート上の表やグラフを図として保存したいということですよね？
解らないのは、
「PP資料のイメージ。」
これは入力中のイメージですよね？
もとは、左側の黒い四角1個が1個の画像ですか？
で、それから目視で値を読み取り、別のシート（別のブック）に入力し、グラフ化。
それらを、
1）入力したしのままのイメージ
2）グラフのみのイメージ
3）入力した表と対応する図を挿入したイメージ
の3つの図として保存したいということでしょうか？
りりさんは、業務に精通していると思いますが、
回答側は何もわからない素人です。
素人にわかるように作業の流れも説明できますか？
それができたら、マクロもどんな風に書かなければいけないのか、
見えてくると思うのですが。。。
（個々の技術は別ですが、そこは追々でいいと思います。）
（まっつわん） 2016/11/27(日) 06:20
こんばんは。りりちゃん☆彡です。
いつもお世話になっております。
（β）様、新しく発見できたなんてお優しい言葉。。ありがとうございます。<(_ _)>
VBAに精通していて、いっぱい知っている（β）さんでも、いまだに発見できることがあるんですね。
つくづくエクセルって奥が深いんだなって思いました。
りりなりに勉強しても、まだまだなはずだよね。駆け出しすぎてまだまだにすらいって無いけど。
ずうずうしいお願いをしているりりに、わざわざ解説まで書いて下さって。
本当に優しい（β）さん。。
いつも本当に、どうもありがとうございます。
りり、まだまだ知識がなさすぎて、このコードについて〜とか何も質問とかできないけど、
いつか、質問もちゃーんとできるりりになりたいです。
理解を深めるのはとってもとっても大変そうだけど、頑張ります。
また色々ご指導いただけたら嬉しいです。(#^.^#)
本当にお世話になりましたﾟ･:,｡★＼(^-^ )♪ありがと♪( ^-^)/★,｡･
（まっつわん）様、切抜きしたBMPとか、グラフを図として保存とかあまり考えていませんでしたが。。
PPで最終的に貼る時は図として貼り付けしています。
PP一枚目にあったのは、最初にUPしたBMP画像の向かって右側を切抜きして、
グラフ用のデーターを入力しますというイメージ図です。
現状ですとグラフ用のエクセルシートはすでにできており、値を変えれば即グラフ画像としてPPに貼りつけられます。資料イメージには3つのグラフしかのっていませんが、実際の資料には沢山グラフをのせています。
今回、トリミングをできるかどうかというのをご相談したのは、
BMP右側のグラフ用の数値を画像をいちいち開いたりしないで一括で見れる方法ないかな？と思って
BMPを一括でエクセルに貼りつけ、その後一気にトリミングできたらいいなと思い相談しました。
結局（β）さんが、素敵なコードを書いて下さりトリミングできるようになりましたので、
これで数値の所だけ（右側だけ）をトリミングしたものでグラフデーターと２窓にしてグラフデーターを
作ろうかなと思っています。
・りりが思っている、作業手順
1.BMPをシート1、シート2に一括とりこみ。
2.シート1の画像を「右側の数字がわ」を一気トリム。
3.シート2の画像を「左側上」を一気トリム。（これはあとでPPに貼りつける）
4.シート1でできた右側数値を2窓にして確認しつつ、グラフ用（すでにあるエクセルファイル）シートに
入力。グラフはできている。
5.PPにて、資料作成。
資料作成時は、グラフ、「左側上」の写真などは、すべて図として貼り付け。エクセルのグラフ用データーも
図として貼り付け。
という感じです。。
上手くお伝えできているといいのですが。。
色々とお世話になり、ありがとうございました。(*^-^*)
また色々教えてください。
（りりちゃん☆彡） 2016/11/27(日) 21:29
（りりちゃん☆彡） 2016/11/27(日) 21:38
なるほど。。。。とりあえずトリミングは出来たのですね＾＾
あとはなんとかするという事なんですね＾＾
＞資料作成時は、グラフ、「左側上」の写真などは、
＞すべて図として貼り付け。エクセルのグラフ用データーも
＞図として貼り付け。
なるほど＾＾
ここもコピペで行くんですね＾＾
これもマクロ化できそうですね＾＾
その辺はまたおいおい質問されるんですかね。。。。
ちゃちゃ混ぜて失礼しましたm(_ _)m
（まっつわん） 2016/11/28(月) 08:29
この作業を行うための個々の機能、これは、マクロではなくエクセル機能を使い分けるほうが より効率的だったりすることもあると思います。 また、実際にどんな手順が必要なのかも、実際の作業要件によって様々ですので、今までアップしたコードの中から 使えそうな部分を部品として取り出して組み合わせてりりちゃん☆彡さんが必要な流れに組み立てていかれればよろしいかと思います。
・今までアップした部品の中で、画像を１つ選んでトリミングし、そのトリミング状態をその他の画像に一括反映というのがありましたね。 でも、これ（トリミングの部分）って、毎回やる必要はないですね。おそらく、対象になる画像は、すべて同じ大きさで、同じトリミングを 行うわけですよね。であれば、画像を選んでトリミングして、そのトリミング情報をどこかに（管理シートのようなシートのどこかのセル） 保存しておくだけの処理にする。あとは、その都度トリミングを行わなくても、この管理シートの情報で自動トリミングできますね。
・シート上に画像を複数配置するとして、そこにどう配置するか、人間が手動でコピペしながら配置していくのか、 特定フォルダの中のBMPデータを自動的に取り出して配置するのか、ファイルダイアログから、これとこれとこれと・・・と選択して 配置するのか、いずれもできますけど、どれが りりちゃん☆彡さん の作業にマッチしているのか、それによって（マクロ処理をするなら） コードを、それように書いておく必要がありますね。
・この場合、難しいのは（コードとして難しいということではなく）どのように これとこれとこれを、この順番で というものを、どう マクロに与えるかという決め事です。決め事があって、その決め事通りに画像が配置されていれば、一括処理もできるでしょう。 それがない場合は、操作者が、これとこれとこれを、この順番で と指示することも必要になりますね。
・あるいは、もしかしたら、シート上にたくさんの画像がある ということではなく このBMPファイルとこのBMPファイルとこのMBPファイルを トリミングしたうえで合成して１つの画像にしてシートに配置する という操作がいいのかもしれませんね。 このあたりは、りりちゃん☆彡さんの要件次第です。
まぁ、いろいろあるわけですが、アップ済みコードあるいは、このレスとわけてアップする次のレスのコード部品をの中で使えそうな部分を りりちゃん☆彡さんが要望する流れに組み立てていかれたら、よろしいかと思います。
アップ予定のコードは以下です。 トリミング情報登録シート名は "Crop" にしてあります。
処理0 (一回こっきり あるいは 切り取り情報変更時に一回処理）
シート上の画像を１つ選択
エクセル機能のトリミングで、その画像を好きな形にトリミング
その画像を選択した状態で、トリミング情報シート にトリミング情報を格納
処理1
画像が格納されているフォルダ指定
そのフォルダからBMP画像を抽出して、シートに貼り付ける
縦方向に貼り付けるので、貼り付け開始位置セルを実行前に選択してから実行
処理2
シート上の合成したい画像を合成したい順序で複数選択
選択された画像をトリミング->合成してグループ化。
選択の最初の画像の位置に配置
処理別方式
BMPファイル選択画面で合成してトリミングしたい画像を、合成したい順序で複数回選択。
（１回あたり１つのファイル選択、これを連続して複数回行う）
選択が終わればキャンセルボタン。
実行前に選択していたセルの場所に作成
処理X おまけ
シート上の合成画像をバラバラにしもとのサイズの戻す（場所は元に戻せないので、重なっている）
処理Y おまけ
シート上の合成画像のみをすべて削除
処理Z おまけ
シート上の単一画像のみをすべて削除
（β） 2016/11/28(月) 20:25
Option Explicit
Const NMCROP As String = "Crop" '★トリミング情報シート（非表示でＯＫ）
Sub 処理0()
If TypeName(Selection) <> "Picture" Then
MsgBox "トリミング情報を取得する画像を選んで実行してください"
Exit Sub
End If
With Selection.ShapeRange(1).PictureFormat
Sheets(NMCROP).Range("A1:D1").Value = Array(.CropLeft, .CropRight, .CropTop, .CropBottom)
End With
End Sub
Sub 処理1()
Dim fPath As String
Dim fName As String
Dim myL As Double
Dim myT As Double
If TypeName(Selection) <> "Range" Then
MsgBox "貼り付け開始セルを選んでから実行して下さい"
Exit Sub
End If
fPath = フォルダ選択
If fPath = "" Then Exit Sub 'キャンセルボタン
myL = Selection.Left
myT = Selection.Top
fName = Dir(fPath & "\*.bmp")
Do While fName <> ""
With ActiveSheet.Shapes.AddPicture(FileName:=fPath & "\" & fName, LinkToFile:=False, _
SaveWithDocument:=True, Left:=myL, Top:=myT, Width:=-1, Height:=-1)
myT = myT + .Height + 10
End With
fName = Dir()
Loop
End Sub
Sub 処理2()
Dim L As Double
Dim T As Double
Dim pic As Object
Dim cnt As Long
Dim cropL As Double
Dim cropR As Double
Dim cropT As Double
Dim cropB As Double
Dim mySel As Object
Dim flg As Boolean
If TypeName(Selection) <> "DrawingObjects" Then
MsgBox "合成する画像を複数選んで実行してください"
Exit Sub
End If
Set mySel = Selection
cnt = mySel.Count '選択されたシェープの数
Application.ScreenUpdating = False
With Sheets(NMCROP)
cropL = .Range("A1").Value
cropR = .Range("B1").Value
cropT = .Range("C1").Value
cropB = .Range("D1").Value
End With
For Each pic In mySel
If Not flg Then
L = pic.Left
T = pic.Top
flg = True
End If
With pic.ShapeRange.PictureFormat
.CropLeft = cropL
.CropRight = cropR
.CropTop = cropT
.CropBottom = cropB
End With
pic.Left = L
pic.Top = T
L = L + pic.Width
Next
If cnt > 1 Then mySel.ShapeRange.Group
End Sub
Function フォルダ選択(Optional stPath As Variant = Empty) As String
Dim myPath As Object
Dim hWnd As Long
Const BIF_RETURNNONLYFSDIRS = &H1 'ディレクトリのみ選択可
Const BIF_EDITBOX = &H10 'Edit_boxを表示
hWnd = Application.hWnd
With CreateObject("Shell.Application")
Set myPath = .BrowseForFolder(hWnd, "フォルダを選んでください", _
BIF_RETURNNONLYFSDIRS Or BIF_EDITBOX, stPath)
If Not myPath Is Nothing Then フォルダ選択 = myPath.Items.Item.Path
End With
End Function
Sub 処理別方式()
Dim L As Double
Dim T As Double
Dim f As Variant
Dim n As Long
Dim fPool As Variant
Dim fName As Variant
Dim cropL As Double
Dim cropR As Double
Dim cropT As Double
Dim cropB As Double
Dim x As Long
If TypeName(Selection) <> "Range" Then
MsgBox "貼り付け開始セルを選んでから実行して下さい"
Exit Sub
End If
L = Selection.Left
T = Selection.Top
With Sheets(NMCROP)
cropL = .Range("A1").Value
cropR = .Range("B1").Value
cropT = .Range("C1").Value
cropB = .Range("D1").Value
End With
'BMPファイルの複数選択
Do
n = n + 1
f = Application.GetOpenFilename("画像ファイル,*.BMP", , n & "番目の画像を選ぶか、選択終了ならキャンセルを押してください")
If f = False Then Exit Do
If Not IsArray(fPool) Then
ReDim fPool(1 To 1)
Else
ReDim Preserve fPool(1 To UBound(fPool) + 1)
End If
fPool(UBound(fPool)) = f
Loop
If Not IsArray(fPool) Then Exit Sub '画像の選択がなかった
If UBound(fPool) = 1 Then
MsgBox "２つ以上の画像を選んでください"
Exit Sub
End If
'トリミングして配置
For Each fName In fPool
With ActiveSheet.Shapes.AddPicture(FileName:=fName, LinkToFile:=False, _
SaveWithDocument:=True, Left:=L, Top:=T, Width:=-1, Height:=-1)
With .PictureFormat
.CropLeft = cropL
.CropRight = cropR
.CropTop = cropT
.CropBottom = cropB
End With
L = L + .Width
End With
Next
'合成
For x = ActiveSheet.Pictures.Count - UBound(fPool) + 1 To ActiveSheet.Pictures.Count
ActiveSheet.Pictures(x).Select False
Next
Selection.ShapeRange.Group
End Sub
Sub 処理X()
Dim gObj As GroupObject
For Each gObj In ActiveSheet.GroupObjects
gObj.ShapeRange.Ungroup
Next
With ActiveSheet.Pictures.ShapeRange.PictureFormat
.CropLeft = 0
.CropRight = 0
.CropTop = 0
.CropBottom = 0
End With
End Sub
Sub 処理Y()
ActiveSheet.GroupObjects.Delete
End Sub
Sub 処理Z()
ActiveSheet.Pictures.Delete
End Sub
（β） 2016/11/28(月) 20:25
ごんばんにゃ(*´▽｀*)りりちゃん☆彡です☆（ゝω・）v
月曜なのに朝っぱらからこき使われてもう、心底疲れて帰ってきたよぉ〜（涙）
最近仕事がどんどん増えて来ちゃって(*_*;
きゃぁ〜〜って感じで( ;∀;)
また、、ここでご相談しないとダメっぽいかもね。
とっ所でっ、お忙しい所、またまたコード書いて下さったんですねっ！？
しかも解説付きっ(*´▽｀*)わーいありがとう(*^^*)
嬉しいです✨
それにしても、、教科書みたいっ。スゴイ。。
いいなぁ。こんなにできていいなぁ。りりも早く書けるようになりたい。
今日は、またもやめんどくさい仕事がりりに回ってきて、なんでりりに回ってくるのかしらと
がっくり落ち込んでいるので、明日頑張ってからまた書込みするね。
そう言う訳で、、少々おまちくださいませっ。
（りりちゃん☆彡） 2016/11/28(月) 21:58
こんばんわ。りりです☆彡
風邪をひいてしまって、夕べは早く寝てしまったのでお返事すぐできなくてすみません(>_<)
さっき、頑張ってみましたっ。
でもイマイチ使い方が分からないんです（涙）りり、コードだけ見ても(?_?)ってなっちゃうから。。
ゴメンね。
Sub 処理0()の所は、切り取りしたい図を選んでからやったけど、↓で黄色くなっちゃいました。。
Sheets(NMCROP).Range("A1:D1").Value = Array(.CropLeft, .CropRight, .CropTop, .CropBottom)
Sub 処理2()の所と、 Sub 処理別方式()の所、画像を選択して押してみたけど、
どっちも With Sheets(NMCROP) の所で止まってしまいました。。りりのやり方が悪いのかも（涙）
もしもお手すきの際があればでかまいませんので、また教えていただけたら嬉しいです。
そうだっ。
先日教えていただいたコードで今ね、ちょうど資料作りしています。
（β）様 様のおかげで、サクサクと業務を進めることができています。（ゝω・）vｷｬﾋﾟ
本当にどうもありがとうございましたっ(*´▽｀*)
（りりちゃん☆彡） 2016/11/30(水) 21:16
コードの先頭に
Const NMCROP As String = "Crop" '★トリミング情報シート（非表示でＯＫ）
これは記述しましたか？
それと、"Crop" という名前のシートは準備しましたか？
（β） 2016/11/30(水) 21:34
こんばんわっ。りりです☆彡
あっ。どっちもしていないです(>_<)
ゴメンナサイっ。
今日は、さっき帰ってきたばっかりでちょっと疲れてしまっているので、
ゆっくり休んで明日頑張ります。
そしたらご報告致します(｀･ω･´)ゞ
りりの都合でごめんなさいっ。
（β）さんも、風邪にはご注意下さいませね✨
（りりちゃん☆彡） 2016/12/01(木) 21:37
こんばんわっ♪りりちゃん☆彡です。
いつもお世話になっております。
さっき頑張ってみました。今度のは、自動でグループ化してくれたり、横に並んでくれるんですね！！
しかも、写真とりこみ機能付き♪
スゴイ☆便利〜。どうもありがとう(*´▽｀*)
資料作成時以外にも、色々伝えそうな気がする(*^-^*)
ところで。。写真とりこみ機能にファイル名を、分かるように自動で入ってもらえるようにしてはもらえないでしょうか？？
（β）さんが作ってくれた取りこみの方が画像が大きめで入ってくれて便利な気がするので、
是非次回はこれを使わせてもらいたいなって思って。。
いつもゴメンナサイ。
お手すきの時でいいのです教えてほしいです。
ファイル名は、写真の下でも右でも左でもどこでもいいんですが。
今使っているの、ネットで見付けたやつなんだけど、
セルの大きさで画像を読み込んでいるタイプなので。。
このお願いは、（β）さんの気が向いた時でいいですよ！！
今回の資料作成、とっても楽でした〜。
本当に色々助けられていて、いっぱいお礼を言っても足りない位お世話になりっぱなしで。。
いつも同じくありがとうございってしか言えないけど、本当にありがとうございました。
そう言えばね、前に教わったコードで、ちょびっと変更したいことあるんだけど。
別レスで聞いてもいいですか？？もしよかったらなんですが。
↓このぶんなんですけど。。
『VBAを使用し、異なる「報告書」データーの合計金額を、別のシートの【集計表】として一覧にしたいです。』
こちらもお手すきの際お返事いただけたら嬉しいです✨
（りりちゃん☆彡） 2016/12/02(金) 22:28
別件、新しいトピを立ててもらえれば、お手伝いしますので、どうぞ。 （ただし、物忘れが激しいので、少々、思い出すリハビリ期間をいただくことになると思いますが）
取り込み画像の名前を表示する件、元々のテーマでは、取り込んだものを合成して動かしますので 名前の表示は、かえって混乱のもとになりますが、あくまで一般的な方法として。
アップ済みの 処理1 をベースに。
処理1_A 画像の右下の横のセルに表示。画像取り込み自体がセル単位ではなくポイント単位にしていますので 表示位置が、画像の下にぴったりあわなく、少し気持ち悪いかもしれませんが。
処理1_B セルに表示するのではなく、画像にマウスを当てると、名前をポップアップ。 タイミングが少し遅いかもしれませんが。
Sub 処理1_A()
Dim fPath As String
Dim fName As String
Dim myL As Double
Dim myT As Double
If TypeName(Selection) <> "Range" Then
MsgBox "貼り付け開始セルを選んでから実行して下さい"
Exit Sub
End If
fPath = フォルダ選択
If fPath = "" Then Exit Sub 'キャンセルボタン
myL = Selection.Left
myT = Selection.Top
fName = Dir(fPath & "\*.bmp")
Do While fName <> ""
With ActiveSheet.Shapes.AddPicture(Filename:=fPath & "\" & fName, LinkToFile:=False, _
SaveWithDocument:=True, Left:=myL, Top:=myT, Width:=-1, Height:=-1)
myT = myT + .Height + 10
.BottomRightCell.Offset(, 1).Value = fName '★追加
End With
fName = Dir()
Loop
End Sub
Sub 処理1_B()
Dim fPath As String
Dim fName As String
Dim myL As Double
Dim myT As Double
If TypeName(Selection) <> "Range" Then
MsgBox "貼り付け開始セルを選んでから実行して下さい"
Exit Sub
End If
fPath = フォルダ選択
If fPath = "" Then Exit Sub 'キャンセルボタン
myL = Selection.Left
myT = Selection.Top
fName = Dir(fPath & "\*.bmp")
Do While fName <> ""
With ActiveSheet.Shapes.AddPicture(Filename:=fPath & "\" & fName, LinkToFile:=False, _
SaveWithDocument:=True, Left:=myL, Top:=myT, Width:=-1, Height:=-1)
myT = myT + .Height + 10
'★以下追加
DoEvents '念のため
With .Parent
.Hyperlinks.Add anchor:=.Shapes(.Shapes.Count), Address:="", _
SubAddress:=.Shapes(.Shapes.Count).TopLeftCell.Address, ScreenTip:=fName
End With
'★追加終わり
End With
fName = Dir()
Loop
End Sub
（β） 2016/12/03(土) 00:11
http://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=179422&rev=0
（まっつわん） 2016/12/03(土) 15:09
こんばんわ。りりちゃん☆彡です。
いつもお世話になっております。
昨日は、ほろよいを飲んだらほろよいを通りこしてよっぱらいになってしまいお返事できませんでした。
りりお酒はチョー弱くて、たまーにしか飲まなないんだけど、良い気分だったから飲んでみた(*^^*)
リクエストしていたファイル名の件、どうもありがとうございますっ✲ﾟ｡.(✿╹◡╹)ﾉ☆.｡₀:*ﾟ✲ﾟ*:₀｡
すごくいい感じでファイル名表示されましたっ。
作業する時、もっと楽になったと思います。
いつもながら、本当にありがとうございましたっ<(_ _)>
色々お忙しいでしょうに。。無理をさせてしまってごめんなさい。
書きこみの時間が、夜中になっていたけど。。分かっていないりりなのに、
ごめんね。
別件の方の件についても、ご了解いただいてありがとうございます。
近いうちご相談させて頂きたいと思います。
今回も色々お世話になってしまって。。いつも感謝しているけど、今回も感謝(*'▽')感謝です。
本当にどうもありがとうございました(*´▽｀*)
最近りりの周りではインフルエンザもはやっております。
くれぐれもご自愛くださいませ。
今後とも、ご指導の程どうぞよろしくお願い致します。
りりちゃん☆彡より
/／ /／ ☆━━━━━━☆━━━ A(*ﾟｰﾟ*)R(ｰﾟ* )I(ﾟ )G( )A( ﾟ)T(* ﾟｰ)O(*ﾟ▽ﾟ*)ﾉ~☆
（まっつわん）様
御無沙汰しております。書込みいただきありがとうございます。
まっつわんさん、りりの画像トリムの件覚えていてくださったんですね。
どうもありがとう。
沢山の、書きこみがある中でおぼえていてくださったなんて、りりすごく嬉しい(*'▽')
それに教えてくださったサイトで知ったけど、パワーポいもVBAってあったんですね！
全然知らなかった（^-^;
せっかく知ったのでちょっと見てみようかなと思うけど、エクセルでできていないのにちょっと
ハードル高いかな？そんな気もちらほらしてます。（＾ｕ＾）
そうそう。教えていただいたサイト見たら、ここでお世話になっている方が複数いらっしゃったような？
りりの気のせい？
今度りりもここと、教えていただいたサイトで勉強させてもらおうと思います。
まっつわんさん、教えてくださってありがとう。
またプチ情報があったら教えていただけたら嬉しいです。
もちろんVBAもですけど(*^^*)
最近空気が乾燥していますね。空気が乾燥すると風邪をひいたりしやすいですから、
お気を付けくださいね(*^-^*)
りりちゃん☆彡より
また次回、私の名前を見かけたらぜひ、ご指導を頂けたら嬉しいです。
りりちゃん☆彡
（りりちゃん☆彡） 2016/12/04(日) 21:07
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.