エクセルの学校：全文検索：Hyper Estraier：マクロ

Results of 1 - 1 of about 27287 for マクロ (0.014 sec.)

[[20201019141422]]: #score: 2168; @digest: ed878b1667a054d65343ba4f677f8a9d; @id: 85520; @mdate: 2020-10-20T10:27:59Z; @size: 8016; @type: text/plain; #keywords: ロテ (103891), 】¥ (50697), 】￥ (33832), 面貼 (23706), 【マ (23471), 像リ (19036), folderpath (16420), ト】 (14920), テス (10948), savewithdocument (9206), linktofile (9206), addpicture (9120), ト画 (8216), 〜〜 (6759), 図面 (5872), ルリ (5650), jpg (4549), スト (4473), 理fo (2748), マク (2549), クロ (2291), 画像 (2272), リス (1964), filename (1911), mysh (1898), shapes (1762), height (1750), selection (1716), width (1705), フル (1625), xlsx (1556), ¥ (1549); 『リストの順番にフォルダを自動選択』（eronex）
お世話になります。 1ファイルリストにあるファイルを開いて、 2指定したフォルダから、 3画像を張り付け、 4微修正し、 5保存。現在、2のフォルダの選択を手動で行っているのですが、下記のリストに基づいて自動で選択し、写真を張り付けしたいのです。初級者ですいませんがよろしくお願い申し上げます。〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜リスト〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜ファイルリストフォルダリスト画像リスト画像リスト D:¥【マクロテスト】￥100.xlsx D:¥【マクロテスト】￥1 D:¥【マクロテスト】￥1¥1.jpg D:¥【マクロテスト】￥1¥2.jpg D:¥【マクロテスト】￥200.xlsx D:¥【マクロテスト】￥2 D:¥【マクロテスト】￥2¥1.jpg D:¥【マクロテスト】￥2¥2.jpg D:¥【マクロテスト】￥300.xlsx D:¥【マクロテスト】￥3 D:¥【マクロテスト】￥3¥1.jpg D:¥【マクロテスト】￥3¥2.jpg D:¥【マクロテスト】￥400.xlsx D:¥【マクロテスト】￥4 D:¥【マクロテスト】￥4¥1.jpg D:¥【マクロテスト】￥4¥2.jpg D:¥【マクロテスト】￥500.xlsx D:¥【マクロテスト】￥5 D:¥【マクロテスト】￥5¥1.jpg D:¥【マクロテスト】￥5¥2.jpg 〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜 Sub 図面貼り付け() act = ActiveWorkbook.Name For i = 2 To 6 Workbooks.Open Range("A" & i) MsgBox Workbooks(act).ActiveSheet.Range("C" & i) Dim folderPath As String With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then folderPath = .SelectedItems(1) End With If folderPath = "" Then Exit Sub Range("B11:F41").Select ActiveSheet.Shapes.AddPicture _ Filename:=folderPath & "¥1.jpg", _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=Selection.Left + 8.8, _ Top:=Selection.Top + 20.75, _ Width:=-1, _ Height:=-1 'Selection.Width Selection.Height Range("G11:K41").Select ActiveSheet.Shapes.AddPicture _ Filename:=folderPath & "¥2.jpg", _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=Selection.Left + 19.5, _ Top:=Selection.Top + 14.25, _ Width:=-1, _ Height:=-1 'Selection.Width Selection.Height Range("E7").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ActiveWorkbook.Save ActiveWorkbook.Close Next End Sub ＜使用 Excel:Excel2013、使用 OS:Windows8 ＞ ---- 配列にリストを取り込んで、配列から取り出しながら処理することになると思います。（OK） 2020/10/19(月) 17:18 ---- 前のトピックも同じですが、基本的にExcelVBAの世界では、シートやセルなど（オブジェクトといいます）をきちんと指定すれば、いちいち選択したりアクティブにしたりする必要がありません。また、【標準モジュール】でRange("A1") など、シートを指定しない記述をすると、ActiveSheetを指定したものとして扱われます。したがって、複数のブックやシートを対象にした処理を考えるなら、ちゃんとオブジェクトを指定するようにすることをお勧めします。また、ブックに複数のシートがある場合、開いたときに想定と違うシートがアクティブになっていることも考えられます。よって、やはりシート名やIndex番号を使ってシートも明確に指定した方がよいとおもいます。（シートが1つしかないないなら、1番目のシートを指定すれば良い）踏まえて、こちらのトピックで提示されたコードを整理してみるとこんな感じになります。（コンパイルエラーにならないことだけチェックしてます。（動作チェックはしておりません）） Sub 図面貼り付け_整理() Dim MySH As Worksheet Dim i As Long Dim folderPath As String Set MySH = ActiveSheet '▼フォルダを選択してもらう With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then folderPath = .SelectedItems(1) Else Exit Sub End If End With 'ループ処理 For i = 2 To 6 With Workbooks.Open(Range("A" & i).Value) MsgBox MySH.Range("C" & i).Value With .Worksheets(1) .Shapes.AddPicture _ Filename:=folderPath & "¥1.jpg", _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=.Range("B11:F41").Left + 8.8, _ Top:=.Range("B11:F41").Top + 20.75, _ Width:=-1, _ Height:=-1 .Shapes.AddPicture _ Filename:=folderPath & "¥2.jpg", _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=.Range("G11:K41").Left + 19.5, _ Top:=.Range("G11:K41").Top + 14.25, _ Width:=-1, _ Height:=-1 With .Range("E7") .HorizontalAlignment = xlLeft .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End With .Save .Close End With Next i End Sub 質問のほうは、上記を眺めてみて（場合によってはステップ実行してみて）どの部分が変われば目的が達成できるか考えてみては如何でしょうか? （もこな2） 2020/10/19(月) 17:38 ---- もこな2様回答ありがとうございます。超初級者で自動保存などを繰り返し作成しました。もともとは、複数箇所だけだったのですが、数百箇所に増えました。そのため、リストを作成しうまくループできないものかと。張り付ける画像は、同じファイル名なのですが画像データが違います。 ※もとはそれぞれ違うファイル名だったのですが簡単に記述すのが困難なためファイル名を統一しました。それで、ご指摘の通り、いちいちフォルダを選択するのが面倒なため、リストを作成し、うまくループできないものかと質問させていただきました。ファイルリストフォルダリスト画像リスト画像リスト D:¥【マクロテスト】¥100.xlsx D:¥【マクロテスト】¥1 D:¥【マクロテスト】¥1¥1.jpg D:¥【マクロテスト】¥1¥2.jpg D:¥【マクロテスト】¥200.xlsx D:¥【マクロテスト】¥2 D:¥【マクロテスト】¥2¥1.jpg D:¥【マクロテスト】¥2¥2.jpg D:¥【マクロテスト】¥300.xlsx D:¥【マクロテスト】¥3 D:¥【マクロテスト】¥3¥1.jpg D:¥【マクロテスト】¥3¥2.jpg D:¥【マクロテスト】¥400.xlsx D:¥【マクロテスト】¥4 D:¥【マクロテスト】¥4¥1.jpg D:¥【マクロテスト】¥4¥2.jpg D:¥【マクロテスト】¥500.xlsx D:¥【マクロテスト】¥5 D:¥【マクロテスト】¥5¥1.jpg D:¥【マクロテスト】¥5¥2.jpg お手数おかけしましがよろしくお願いいたします。（eronex） 2020/10/20(火) 09:17 ---- なんか話がかみ合っていませんが、「図面貼り付け_整理」は見ていただけたのでしょうか? 要はこうなってますよね? Sub 図面貼り付け_整理簡略版() Dim i As Long 'ループ処理 For i = 2 To 6 With Workbooks.Open(MySH.Range("A" & i).Value) ←★ここで、対象ブックの（フル）パスを指定している With .Worksheets(1) .Shapes.AddPicture _ Filename:=folderPath & "¥1.jpg" ←★ここで、対象ファイル（1つめの画像）のフルパスを指定している .Shapes.AddPicture _ Filename:=folderPath & "¥2.jpg" ←★ここで、対象ファイル（2つめの画像）のフルパスを指定している End With .Save .Close End With Next i End Sub つまり、★のところがそれぞれ変わればよいということではありませんか? 幸いにして、もともと自ブック?のアクティブシートにリストのようなものがあるようなので、それを拡張すればよいのではないでしょうか? （もこな2） 2020/10/20(火) 19:27 ...; http://www.excel.studio-kazu.jp/wiki/kazuwiki/202010/20201019141422.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ