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

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

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

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

解決済

セルの値=サブフォルダ名の時写真を張り付ける

bonta
bonta

総合スコア5

VBA

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

1回答

0評価

0クリップ

153閲覧

投稿2022/06/17 06:51

編集2022/06/22 17:27

初心者質問で申し訳ございません。

Excel上で簡単に複数の写真を張り付けるVBAを作っております。
Excelで写真一覧表を作成しており、作品のタイトルを(y, 2)に入力しております。
メインフォルダをパスで指定を行い、(y, 2)のセルの値のサブフォルダを(y, 11)に貼付けができればと思って作っております。

写真はタイトルごとにサブフォルダを作成し、その中に一枚のみ入れてあります。
イメージとしては

「写真」フォルダ(サブフォルダをまとめている親フォルダ)

「(y, 2)」サブフォルダ(写真を一枚のみ格納)
「(y, 3)」
「(y, 4)」
「(y, 5)」 ・・・・・・・
といったイメージです。

親フォルダのファイルパスはInputBoxにて指定を行い、
その他は(y, 2)のセル内の値と同じサブフォルダから写真を貼り付けができればと思います。

途中までは作成ができたのですが、(y, 2)の値を用いてサブフォルダをパス指定を行うことが難しく挫折しております。

初心者で申し訳ございませんがご教授をいただきたく思います。

以下に作成したコードを載せます。
作成した内容は親フォルダをパス指定し、その中にあるサブフォルダを上から順に貼付けるという内容です。

コード ```Sub 写真貼り付け() Dim alert As VbMsgBoxResult alert = MsgBox("実行してよろしいですか?", vbYesNo + vbQuestion, "実行確認") If alert = vbYes Then MsgBox "親フォルダのパスを入力してください。" '←「はい」ボタンをクリックしたときの処理。 End If ' 親フォルダのパス root_dir = InputBox("親フォルダーのパス名の入力" + Chr(10) + "例:写真", "親フォルダー確認") & "\" ' フォルダ内のサブフォルダをスキャン Set fso = CreateObject("Scripting.FileSystemObject") Set sub_dirs = fso.GetFolder(root_dir).SubFolders y = 2 For Each sub_dir In sub_dirs ' このサブフォルダについて処理 y = importImagesFromOneSubDir(sub_dir, y, root_dir) Next End Sub ' ある一つのサブフォルダについての処理 Private Function importImagesFromOneSubDir(sub_dir, y, root_dir) 'MsgBox sub_dir.Name ' このフォルダ内の画像をすべて列挙 file_name = Dir(sub_dir & "\*.*") Do While file_name <> "" ' このファイルの拡張子を調べる If isImageFile(file_name) Then ' 画像であれば,取り込んで次の行へ importImageFile file_name, y, root_dir, sub_dir y = y + 1 End If ' 次のファイルを取得 file_name = Dir() Loop ' 現在の行を返す importImagesFromOneSubDir = y End Function ' 画像ファイルかどうか,拡張子で判定する Private Function isImageFile(file_name) ' ピリオドは後ろから何文字目か pos_period = InStrRev(file_name, ".") If pos_period > 0 Then ' 拡張子を切り出し file_ext = LCase(Mid(file_name, pos_period + 1)) ' 画像の拡張子か?(小文字で指定可) If _ file_ext = "jpg" Or _ file_ext = "jpeg" Or _ file_ext = "bmp" Or _ file_ext = "gif" Or _ file_ext = "png" _ Then ' 画像であると判定 ret = True Else ret = False End If Else ret = False End If isImageFile = ret End Function ' ある一つの画像ファイルをシート中に取り込む Private Sub importImageFile(file_name, y, root_dir, sub_dir) file_path = sub_dir & "\" & file_name ActiveSheet.Cells(y, 11).Select Set MyShape = ActiveSheet.Shapes.AddPicture( _ Filename:=file_path, _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=Selection.Left + 3.4, _ Top:=Selection.Top + 3, _ Width:=Application.CentimetersToPoints(4.55), _ Height:=Application.CentimetersToPoints(3.41)) End Sub

良い質問の評価を上げる

以下のような質問は評価を上げましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

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

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

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

teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

  • プログラミングに関係のない質問
  • やってほしいことだけを記載した丸投げの質問
  • 問題・課題が含まれていない質問
  • 意図的に内容が抹消された質問
  • 過去に投稿した質問と同じ内容の質問
  • 広告と受け取られるような投稿

評価を下げると、トップページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

meg_

2022/06/18 00:34

コードは関数毎に「コードの挿入」で記入いただけないでしょうか。 また現状どこまで実現できているのでしょうか?
bonta

2022/06/18 01:04

ありがとうございます。 現状実現できているのは ・親フォルダをinputBoxにて指定 ・サブフォルダを開けるための繰り返し処理 ・エクセル上での(y, 11)を用いた写真貼り付け位置、写真貼り付けサイズ できていないことは ・サブフォルダを(y, 2)のセルの値を利用してファイルパスを指定することです。

まだ回答がついていません

会員登録して回答してみよう

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

ただいまの回答率
87.20%

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

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

質問する

関連した質問

同じタグがついた質問を見る

VBA

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