[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『指定したセルに写真を一括取り込み』（ともふく）
はじめまして。初めてマクロを作成している初心者です。
ネットで検索して使えそうなマクロを見つけて、つなぎ合わせて作成している段階です。
写真複数枚を一括で取り込み、指定したセルに貼り付けられるようにマクロを作成しています。
貼り付けしたいセルを予めに結合しており、二列で最大150枚程の写真を取り込めるようにしたいです。
マクロ 1
貼り付けたい結合セルに「aaa」と入力しており、「aaa」と入力してあるセルを検索、選択する。
Sub セル選択()
Dim FoundCell As Range, FirstCell As Range, Target As Range
Set FoundCell = Cells.Find(What:="aaa")
If FoundCell Is Nothing Then
MsgBox "見つかりません"
Exit Sub
Else
Set FirstCell = FoundCell
Set Target = FoundCell
End If
Do
Set FoundCell = Cells.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then
Exit Do
Else
Set Target = Union(Target, FoundCell)
End If
Loop
Target.Select
End Sub
マクロ2
選択してあるセルに写真を貼り付ける。
Sub 選択セルに合わせて()
Application.ScreenUpdating = False
Dim myFileName As Variant 'バリアント型に
Dim myCount As Long 'カウント用変数を定義
Dim r As Range 'Selectionのループ用
If TypeName(Selection) <> "Range" Then
MsgBox "セルを選択して実行して下さい。"
Exit Sub
End If
myFileName = Application.GetOpenFilename( _
FileFilter:="画像 ,*.jpg; *.gif; *.bmp", MultiSelect:=True) 'MultiSelectをTrue
If VarType(myFileName) <> vbBoolean Then 'キャンセル判定を少し変更
For Each r In Selection.Areas '選択範囲をRange型変数ｒでループ
myCount = myCount + 1 'カウンターを１プラス
If myCount > UBound(myFileName) Then Exit Sub '選択セル数がファイル数を超えたら終了
With ActiveSheet.Pictures.Insert(myFileName(myCount)) 'myCount番目のパスでインサート
.Left = r.Left '各位置、サイズをセルｒのプロパティで設定
.Top = r.Top
.Width = r.Width
.Height = r.Height
End With
Next r
Application.ScreenUpdating = True
End If
End Sub
マクロ3
リンクとして貼り付けられている画像を削除、実像として貼り付け
Sub リンク画像クリップボード貼付()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Type = msoLinkedPicture Then
shp.Select
Selection.Copy
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:= _
False
shp.Delete
End If
Next
End Sub
の順で実行していますが、マクロ3を実行した際に、リンクが貼り付けられていたセルからズレてしまいます。
セルの座標を指定する必要があるのか、調べてもよくわからず、手詰まり状態です。
マクロ3でマクロ1で選択したセルに合わせて貼り付けられるように
ご教授願います。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
'マクロ3 Sub リンク画像クリップボード貼付() Dim shp As Shape Dim ix As Single Dim iy As Single
For Each shp In ActiveSheet.Shapes
If shp.Type = msoLinkedPicture Then
ix = shp.Left
iy = shp.Top
shp.Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
Selection.Left = ix
Selection.Top = iy
End If
Next
End Sub
（???） 2018/09/25(火) 13:10
初歩的なことだったかもしれませんが、わからずに困っていたのでとても助かりました。
もう一つ気になることがあるのですが、
???さんのおっしゃる再圧縮はどのコードで示されていますか？
(60枚貼り付けて、ファイルは2.3MB)
理想的には圧縮率を調整できればいいなと思っていたのですが、
複雑になりそうで諦めていました。
また、現状で60枚程度の画像を取り込むのに60秒くらい掛かっていますが、
時間がかかっている無駄なコード等があれば教えて頂きたいです。
宜しくお願いします。
（ともふく） 2018/09/25(火) 13:35
Sub 一括写真取り込み()
Call セル選択
Call 選択セルに合わせて
Call リンク画像クリップボード貼付2
End Sub
ということではないですよね･････？
一つのモジュールに全てをまとめようと思いましたが、
調べながらやっているため、そこまで辿り着けていません。。。
もう少し調べてみます。
（ともふく） 2018/09/25(火) 13:39
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
更に圧縮するならマクロ2の
.Width = r.Width / 2
.Height = r.Height / 2
にしておいて、マクロ3で2倍にすると面積が1/4になるので容量もそのくらい減るでしょうね。
しかし、この場合は見て分かるレベルで画質が劣化します。
読み込みに時間がかかる件は、元の画像ファイルのサイズとパソコンのスペックに大きく影響を受けるので、マクロの方で劇的に改善するのは難しいと思います。
膨大な写真を貼る場合のオススメはXnConverter等の高速で圧縮出来るフリーソフトで予め写真の画質を一括で下げておいて、そのファイルをマクロで読み込ませることです。
マクロを一つにまとめるというのはSub〜End Subを1つにするってことですね。
その例だと順番に呼び出しているだけなので、???さんの言うこととは異なるとおもいます。
複数の目的のマクロを一つにすることで、変数は共有出来るようになりますが個別に実行できなくなるので、利用方法によっては止めたほうが良い場合もあります。
その時はモジュール変数を使うとか、とうふくさんの例をベースに、ByRefで値を返せるようにすると良いと思います。
（名無し） 2018/09/25(火) 14:24
1つにまとめる、というのは、サブプロシジャを連続で呼び出すのではなく、1つのサブプロシジャにしてしまえ〜、という事です。 オブジェクト指向の考え方には反するのですが、セルを探して、画像指定して貼って、再圧縮までを1つにまとめた方が、変数が減って、コードも短くなって、簡単になると思います。 現状でも引数は指定していませんし、単純に1つにまとめて、不要になった変数を消す位ですよ。
名無しさんの言うように、適切な引数を用意してサブプロシジャは分けたまま、というのは、個々のサブプロシジャを再利用する場合に有効な方法ですが、今回の場合は、座標関係の変数を減らせたり、ScreenUpdatingをまとめて全体にかけられたり（分割しても、親プロシジャでかければ良いだけですけどね）できるので、1つにするのが良いかなぁ、と思いました。
（???） 2018/09/25(火) 15:23
やはりマクロでの劇的なスピードアップは難しいですか、
そんな気はしていましたが。。。
予め写真を圧縮しておく方法は、参考にさせて頂きます。
現状ではByRefと言われて何も思いつかない知識レベルですので、
もう少し勉強してみて挑戦してみます。
的確なアドバイスありがとうございます。
（ともふく） 2018/09/25(火) 19:10
サブプロシージャを一つにする方法や変数についての知識がほとんど無いため、
言っている事はなんとなく理解できますが、どうしたらいいかと言われるとまったくわからないのが現状です。
おそらく、ある程度のレベルの方が修正すれば、すぐに一つにまとめてスッキリできるのでしょう。。。。
今回はネットを調べて、使えそうなマクロをコピペで作成したに過ぎませんが、
マクロで作業を効率化できたことが嬉しく、今後もう少し勉強してみようと思いました。
的確なアドバイスありがとうございました。
（ともふく） 2018/09/25(火) 19:22
解決してるので、以下蛇足ですが、
（１）"Target"という変数名、ダメじゃないですけど、将来シートイベントを使うようになったときに、煩わしいような気がするので今のうちから、別の変数名で癖付けておいたほうがいいんじゃないかとおもったり。
（２）セル結合してるから、
Target.Select 〜 Selection.Areas
なのでしょうが、MergeAreaプロパティを使えばいちいち、Selectする必要は無いように思います。
【参考】
http://officetanaka.net/excel/vba/tips/tips50.htm
（３）Findメソッドの引数をいくつか省略しているので、状況によっては、セルの検索に失敗することがあるように思います。
【参考】
http://www.moug.net/tech/exvba/0150111.html
と、ここまで書いておいて画像圧縮の話はわからないので、ほぼ元のコードを上記3つだけ気にしてつなげてみました。
Sub 一括()
Dim FoundCell As Range, FirstCell As Range, MyRNG As Range
Dim myFileName As Variant
Dim i As Long '「MsgBoxの返値」と「For〜Nextのカウンタ」で使いまわし
'-------------------------------------------------
'// 対象セルの検索 //
With ActiveSheet.UsedRange
Set FoundCell = .Cells.Find(What:="aaa", LookIn:=xlValues, LookAt:=xlWhole, After:=.Cells(.Rows.Count, .Columns.Count))
If FoundCell Is Nothing Then
MsgBox "「aaa」が入力されているセルが見つかりません"
Exit Sub
Else
Set FirstCell = FoundCell
Set MyRNG = FoundCell.MergeArea
End If
Do
Set FoundCell = .Cells.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then Exit Do
Set MyRNG = Union(MyRNG, FoundCell.MergeArea)
Loop
End With
'-------------------------------------------------
'// ダイアログでユーザに画像ファイルを選択させる //
myFileName = Application.GetOpenFilename _
(FileFilter:="画像 ,*.png; *.jpg; *.gif; *.bmp", MultiSelect:=True)
'キャンセル判定
If VarType(myFileName) = vbBoolean Then
MsgBox "ファイル選択がキャンセルされました"
Exit Sub
End If
'-------------------------------------------------
'// ファイル数とセル範囲数のチェック //
Select Case True
Case MyRNG.Areas.Count > UBound(myFileName)
i = MsgBox("セル範囲の方が " & vbCrLf & MyRNG.Areas.Count - UBound(myFileName) _
& "個 多いですが続けてよろしいですか？", vbYesNo, "ファイル数・セル範囲数不一致")
Case MyRNG.Areas.Count < UBound(myFileName)
i = MsgBox("ファイル数の方が " & vbCrLf & UBound(myFileName) - MyRNG.Areas.Count _
& "個 多いですが続けてよろしいですか？", vbYesNo, "ファイル数・セル範囲数不一致")
End Select
If i = 7 Then Exit Sub
'-------------------------------------------------
'// ループ処理 //
'Application.ScreenUpdating = False 'コメントアウト解除は意味が分かってからを推奨
For i = 1 To Application.Min(MyRNG.Areas.Count, UBound(myFileName))
With ActiveSheet.Pictures.Insert(myFileName(i))
.Left = MyRNG.Areas(i).Left
.Top = MyRNG.Areas(i).Top
.Width = MyRNG.Areas(i).Width
.Height = MyRNG.Areas(i).Height
End With
Next i
Application.ScreenUpdating = True
End Sub
2018/09/26(水) 00:26 コードとコメント微修正
（もこな２） 2018/09/26(水) 00:05
アドバイスありがとうございます。
プロシージャーをまとめて、追加して頂いた機能について、
私が理解できた範囲で確認です。
findの条件について完全一致等の条件を加えて、失敗することを無くした。
参照のページを確認し、概ね理解することができました。
変数は複数あったものを、「i」で統一？したということですよね？
その方がわかりやすいから？ですよね。
統一した方が良かったと感じるのは、もう少し知識を深めないとよくわかりません。(すいません)
また、いくつかMsgBoxを追加して頂き、ありがとうございます。
選択セル＞写真数の場合は、特に不要であったため、削除させていただきました。
ループ処理で写真をInsertだとリンクのままでしたので、
その下にリンクから実像の処理を追加しました。
おそらくここの変数についても、「i」で成立するはずですよね･････？
「ix」「iy」を「i」に変更してみましたが、どこかが間違っているようで、
エラーが発生しました。
Sub 一括()
Dim FoundCell As Range, FirstCell As Range, MyRNG As Range
Dim myFileName As Variant
Dim i As Long '「MsgBoxの返値」と「For〜Nextのカウンタ」で使いまわし
'-------------------------------------------------
'// 対象セルの検索 //
With ActiveSheet.UsedRange
Set FoundCell = .Cells.Find(What:="aaa", LookIn:=xlValues, LookAt:=xlWhole, After:=.Cells(.Rows.Count, .Columns.Count))
If FoundCell Is Nothing Then
MsgBox "「aaa」が入力されているセルが見つかりません"
Exit Sub
Else
Set FirstCell = FoundCell
Set MyRNG = FoundCell.MergeArea
End If
Do
Set FoundCell = .Cells.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then Exit Do
Set MyRNG = Union(MyRNG, FoundCell.MergeArea)
Loop
End With
'-------------------------------------------------
'// ダイアログでユーザに画像ファイルを選択させる //
myFileName = Application.GetOpenFilename _
(FileFilter:="画像 ,*.png; *.jpg; *.gif; *.bmp", MultiSelect:=True)
'キャンセル判定
If VarType(myFileName) = vbBoolean Then
MsgBox "ファイル選択がキャンセルされました"
Exit Sub
End If
'-------------------------------------------------
'// ファイル数とセル範囲数のチェック //
Select Case True
Case MyRNG.Areas.Count < UBound(myFileName)
i = MsgBox("ファイル数の方が " & vbCrLf & UBound(myFileName) - MyRNG.Areas.Count _
& "個 多いですが続けてよろしいですか？", vbYesNo, "ファイル数・セル範囲数不一致")
End Select
If i = 7 Then Exit Sub
'-------------------------------------------------
'// ループ処理 //
'Application.ScreenUpdating = False 'コメントアウト解除は意味が分かってからを推奨
For i = 1 To Application.Min(MyRNG.Areas.Count, UBound(myFileName))
With ActiveSheet.Pictures.Insert(myFileName(i))
.Left = MyRNG.Areas(i).Left
.Top = MyRNG.Areas(i).Top
.Width = MyRNG.Areas(i).Width
.Height = MyRNG.Areas(i).Height
End With
Next i
Application.ScreenUpdating = True
'--------------------------------------------------
'//リンクを実像に//
Dim shp As Shape
Dim ix As Single
Dim iy As Single
For Each shp In ActiveSheet.Shapes
If shp.Type = msoLinkedPicture Then
ix = shp.Left
iy = shp.Top
shp.Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
Selection.Left = ix
Selection.Top = iy
End If
Next
End Sub
皆さんのご指摘を受けて、何となく変数等の使い方がわかってきたような気がします。
楽しくなってきました。
（ともふく） 2018/09/26(水) 14:00
＞ Dim i As Long '「MsgBoxの返値」と「For〜Nextのカウンタ」で使いまわし
本来MsgBoxの戻り値はVbMsgBoxResult列挙型なので、いくらスコープが違うからと言って同じ変数を使うのはどうかと・・？
私なら別途Dim Result As VbMsbBoxResultを定義します。
（使い方は好みですが、初心者には優しくないかなと思います）
（名無し） 2018/09/26(水) 14:24
いろいろ試してみてください。 だんだん意味が分かってくると思います。
（???） 2018/09/26(水) 15:14
名無しさん
アドバイスありがとうございます。
ix,iyとiの変数は、まったく別物でしたか、、、わかったつもりになって早合点していました。お恥ずかしい。
現状では、VbMsgBoxResult列挙型と言われても、まったくわからないレベルです。
そのため、新しい定義を設けた方が良いとのご指摘ですが、
とりあえずもう少しわかってきてからにしたいと思います。
？？？さん
引き続き、アドバイスありがとうございます。
仰る意味はなんとなくわかります。
ループと実像貼り付けを単純にくっつけてみましたが、
Next iに対する変数エラーが出ています。
For i = 1 To Application.Min(MyRNG.Areas.Count, UBound(myFileName))
With ActiveSheet.Pictures.Insert(myFileName(i))
.Left = MyRNG.Areas(i).Left
.Top = MyRNG.Areas(i).Top
.Width = MyRNG.Areas(i).Width
.Height = MyRNG.Areas(i).Height
End With
Dim shp As Shape
Dim ix As Single
Dim iy As Single
For Each shp In ActiveSheet.Shapes
If shp.Type = msoLinkedPicture Then
ix = shp.Left
iy = shp.Top
shp.Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
Selection.Left = ix
Selection.Top = iy
End If
Next i
初歩的なことで恐縮ですが、Forに対するNext iについて、解説して頂けると助かります。
同じ操作をマクロで行う場合でも答えは一つでは無く、コードの組み合わせも複数あるとわかってきました。
今回のご指摘で一枚ずづカット＆ペーストいた方が良いというのは、
上級者のお二方から見たら、無駄なコードが多くあるとからでしょうか？
（コードがすっきりさせると、それともエラーも少なくなり動作が早くなるから？）
（ともふく） 2018/09/27(木) 09:41
とうふくさん
＞VbMsgBoxResult列挙型と言われても、まったくわからないレベルです。
知らない言葉は調べましょう
https://www.relief.jp/docs/excel-vba-vbmsgboxresult.html
それだと二重ループになってますよ！
くっつけるのはForの中だけです。
ちなみにそのエラーが出る原因はNextの数が足りないからです。
＞無駄なコードが多くあるとからでしょうか？
前のコードだと
１．For...該当セルか選択ファイルの少ない方の数だけ繰り返し
＞写真を挿入
２．For Each...ワークシート上の全てのシェイプの数だけ繰り返し
＞写真を切り取って、再貼付け
になりますから、２の部分のループ回数が、既存のシェイプの数が増えるほど回数が増大しますよね。
くっつけると
１．For...該当セルか選択ファイルの少ない方の数だけ繰り返し
＞写真を挿入
＞写真を切り取って、再貼付け
となりますから、必要最小限のループ回数になりますし、変数を省略することができます。
というわけで、私の思うようにくっ付けるとこうなりますね
'-------------------------------------------------
'// ループ処理 //
Dim shp As Shape '←変数の宣言は本当はSubの下に書いてね
'Application.ScreenUpdating = False 'コメントアウト解除は意味が分かってからを推奨
For i = 1 To Application.Min(MyRNG.Areas.Count, UBound(myFileName))
'//写真を貼り付け//
Set shp = ActiveSheet.Pictures.Insert(myFileName(i))
With shp
.Left = MyRNG.Areas(i).Left
.Top = MyRNG.Areas(i).Top
.Width = MyRNG.Areas(i).Width
.Height = MyRNG.Areas(i).Height
End With
'--------------------------------------------------
'//リンクを実像に//
shp.Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
Selection.Left = MyRNG.Areas(i).Left
Selection.Top = MyRNG.Areas(i).Top
Next i
Application.ScreenUpdating = True
（名無し） 2018/09/27(木) 10:13
Sub 一括()
Dim FoundCell As Range, FirstCell As Range, MyRNG As Range
Dim myFileName As Variant
Dim i As Long '「MsgBoxの返値」と「For〜Nextのカウンタ」で使いまわし
'-------------------------------------------------
'// 対象セルの検索 //
With ActiveSheet.UsedRange
Set FoundCell = .Cells.Find(What:="aaa", LookIn:=xlValues, LookAt:=xlWhole, After:=.Cells(.Rows.Count, .Columns.Count))
If FoundCell Is Nothing Then
MsgBox "「aaa」が入力されているセルが見つかりません"
Exit Sub
Else
Set FirstCell = FoundCell
Set MyRNG = FoundCell.MergeArea
End If
Do
Set FoundCell = .Cells.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then Exit Do
Set MyRNG = Union(MyRNG, FoundCell.MergeArea)
Loop
End With
'-------------------------------------------------
'// ダイアログでユーザに画像ファイルを選択させる //
myFileName = Application.GetOpenFilename _
(FileFilter:="画像 ,*.png; *.jpg; *.gif; *.bmp", MultiSelect:=True)
'キャンセル判定
If VarType(myFileName) = vbBoolean Then
MsgBox "ファイル選択がキャンセルされました"
Exit Sub
End If
'-------------------------------------------------
'// ファイル数とセル範囲数のチェック //
Select Case True
Case MyRNG.Areas.Count < UBound(myFileName)
i = MsgBox("ファイル数の方が " & vbCrLf & UBound(myFileName) - MyRNG.Areas.Count _
& "個 多いですが続けてよろしいですか？", vbYesNo, "ファイル数・セル範囲数不一致")
End Select
If i = 7 Then Exit Sub
'-------------------------------------------------
'// ループ処理 //
'Application.ScreenUpdating = False 'コメントアウト解除は意味が分かってからを推奨
For i = 1 To Application.Min(MyRNG.Areas.Count, UBound(myFileName))
With ActiveSheet.Pictures.Insert(myFileName(i))
.Width = MyRNG.Areas(i).Width
.Height = MyRNG.Areas(i).Height
.Cut
End With
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
With Selection
.Left = MyRNG.Areas(i).Left
.Top = MyRNG.Areas(i).Top
End With
Next i
Application.ScreenUpdating = True
End Sub
（???） 2018/09/27(木) 10:53
'// ファイル数とセル範囲数のチェック //
If MyRNG.Areas.Count < UBound(myFileName) Then
If MsgBox("ファイル数の方が " & vbLf & _
UBound(myFileName) - MyRNG.Areas.Count & "個 多いですが続けてよろしいですか？" _
, vbYesNo Or vbQuestion, "ファイル数・セル範囲数不一致") <> vbYes Then
Exit Sub
End If
End If
（???） 2018/09/27(木) 11:21
名無しさん
二重のループになっており、Nextの数が足りていなかったのですね。。
Nextに何を持ってきたらいいか、現時点ではわかりませんでした。
？？？さんの修正版で無事に機能することを確認できました。
ありがとうございます。
If i = 7 Then Exit Subについては、なんで数字を用いているのだろうと思っていましたが、
修正ありがとうございます。
MsgBoxの変数とVbMsgBoxResult列挙型について、調べてみました。
Sub 一括修正ver3()
Dim FoundCell As Range, FirstCell As Range, MyRNG As Range
Dim myFileName As Variant
Dim i As Long '「MsgBoxの返値」と「For〜Nextのカウンタ」で使いまわし
Dim Result As VbMsgBoxResult 'MsgBoxの返値'
'-------------------------------------------------
'//取り込み開始 選択//
Result = MsgBox("一括取り込みを開始します。", vbYesNo)
If Result = vbNo Then
Exit Sub
End If 'キャンセルの場合は、何もしない'
以下？？？さんの修正コード
こういう使い方をした方が良いとういうことでしょうか。
以下のMsgBoxの返り値についても、同様に変数を変更した方が良い？ということですかね。。。
また、私の目的の仕様について、説明不足でした。
本マクロでは、一括で取り込みを行い、手動での取り込みはしないという前提で作成しています。
本当は取り込み後に追加したい場合もありますが、複雑になりそうなので
諦めていました。セルを結合してある同じシートを別に作成しておいて、追加の場合はそのシートでマクロを実行し、本シートに写真をコピペで追加対応しようと思っています。(かなり原始的な方法ですが・・・・)
一回取り込んでしまうと目印の「aaa」が邪魔になってしまい、
セルの選択をどうすれば良いか思いついていません。。。。
そもそも「aaa」という目印を探すということ自体がナンセンス？なんですかね。。。
本当は指定した大きさの結合セルを検索・選択するということができるのでしょうか。
そのため、？？？さんの
２）画像を貼り終わっても、目印にした「aaa」の文字列は消していないので、貼った後に再度別の画像を選択すると、重ねて貼ってしまう。文字を消せば追加貼り付けできるのでは？
については、恐縮ですがもう少しヒントを頂ければと思います。
（ともふく） 2018/09/27(木) 13:08
そして、私のコードではイコールでなく、不等号に変えていますね？ これは今回の場合ならば意味なかったりしますが、ダイアログを×ボタンで閉じる、なんて、ボタンを押さなかった場合でも矛盾しない書き方にしています。
次に、aaaを消す方法ですが、画像オブジェクトはその左上がシート上のどのセルになっているかが判る、TopLeftCellプロパティというのを持っています。これを利用すれば文字列を消せるので、以下のように変えて試してみてください。（TopLeftCellプロパティではなく、MyRNG.Areas(i).Value = "" で貼ったセルの文字列を消してもOK）
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
With Selection
.Left = MyRNG.Areas(i).Left
.Top = MyRNG.Areas(i).Top
.TopLeftCell.Value = ""
End With
（???） 2018/09/27(木) 14:17
ふむふむ、、、
確かに他者でも読めた方が良いコーディングだと思います。
MsgBoxは変数を省略できるんですか････。
使い方が複雑ですね。。。。
また、不等号の使用箇所についても確認しました。
本マクロでは特に不要とのことですが、
今後作成するときに参考にさせて頂きます。
また、最後に「aaa」の消去コードを教えて頂きまして、
ありがとうございます。
TopLeftCellプロパティとは、なんと素晴らしいものでしょう。
いろいろと使うことができそうなコードですね。
「aaa」を消したあとに、もう一度マクロを実行すれば、
続きから貼り付けができる!!と思いましたが、写真の選択を間違えて一度貼り付けた写真を削除して、
もう一度マクロを実行した際に、初めから取り込めないと気付きました･････。
オブジェクトが無くなったら、TopLeftに「aaa」を入力する。とかできるのかなーと思ったりしましたが、
現状の修正して頂いたマクロで十二分に効率化ができました。
そのため、本マクロについては、これで完成とさせて頂きます。
本当にありがとうございました。
最後に、これは本マクロと関係のないことですが、
？？？さんはVBA(その他プログラミング)を作成し始めて、どれくらいの経験を積んでいるのでしょうか。
差し支えなければ、回答して頂けると嬉しいです。
（ともふく） 2018/09/27(木) 23:18
また、変数代入せずに直接結果を判定するのは、Noなら処理を抜けるような、判定が1回しかない場合のみの手段です。 あとでまたYesなのかNoなのかの結果が必要ならば、変数代入しましょう。 当面は、必ず変数で戻り値を受ける一択でコーディングして問題ないです。
ちなみに、私が初めて自分でプログラミングしたのは、ポケコンのBASICです。（1kByteちょいしかプログラム領域が無く、切り詰めるのが大変でした。命令でも行番号でも変数名でも、なんでも1文字1byte） その後パソコンを買ったり、汎用機、ミニコン、オフコン含め、いろいろな機種で、いろいろなOSや言語を使ったりしてきました。 なので、最初は調べたくてもWebなんか無いし、人に聞いても答えが得られない、という状況が多かったですね。
（???） 2018/09/28(金) 09:31
MsgBoxの戻り値は、Long型が多数派なんですね。
コードを見た回数が圧倒的に少ないため、これから？？？さんの言葉が身に染みると思います。
とりあえず、必ず変数で戻りを受けるようにしたいと思います。
また、関係ない質問に答えて頂き、ありがとうございます。
ポケコンについて調べてみましたが、私が産まれる少し前に発売されていますね。
その頃から、プログラミングしているということは、
今ではどんなことまでできるのか想像もつきません。(アプリやソフトの開発とかは余裕ですよね。。。）
プログラミングが普及したころから第一線で携わっている方とのことで、
迅速にわかりやすく解説して頂いた事も合点がいきました。
私は化学系の仕事でして、マクロは存在だけは知っている程度でしたが、
ご協力頂いてなんとか完成することができ、もう少し勉強してみたいと思いました。
(仕事の効率化もできますし)
今はネットでほとんどのことは学べますし、？？？さんのように教えて頂ける人も多いので、
恵まれた環境に感謝しています。
良いきっかけを作って頂き、ありがとうございました。
（ともふく） 2018/09/28(金) 22:16
本筋から言えば、真面目にヘルプを読むのでしょうけど、私はよく↓を参考にします。
http://officetanaka.net/excel/vba/function/MsgBox.htm
（もこな２） 2018/09/29(土) 10:05
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.