none
EXCEL2016 複数の画像を挿入するマクロ RRS feed

  • 質問

  • 複数の画像を挿入するマクロを使用しEXCAELのシートに写真を複数枚貼り付けて資料を作製しております。

    今までは13行毎の定間隔で写真を貼り付けるようにレイアウトしていましたが、今回一カ所行を追加した(3枚目と4枚目のあいだに2行追加、追加した2行の間で改ページ)のですが、その変更に伴い写真の貼り付け位置が変わる為、マクロの変更もしなければならないと思っていたのですが、なぜかマクロの変更をしなくても新しいレイアウトに写真が正しく挿入されます。
    これは一体なぜなのでしょうか。なお長くなりますがVBAソースを以下にお示しします。

    また、EXCELのシートのイメージをスクリーンショット等で添付する方法はありますでしょうか。

    Sub 複数の画像を挿入名前無し13()
      
        Dim strFilter As String
        Dim Filenames As Variant
        Dim PIC       As Picture
       
        Dim objFileName As String
        Dim objShape As Shape

       
        ' 「ファイルを開く」ダイアログでファイル名を取得

        strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
        Filenames = Application.GetOpenFilename( _
                        FileFilter:=strFilter, _
                        Title:="図の挿入(複数選択可)", _
                        MultiSelect:=True)
        If Not IsArray(Filenames) Then Exit Sub
     
        ' ファイル名をソート
        Call BubbleSort_Str(Filenames, True, vbTextCompare)
       
        ' 貼り付け開始セルを選択
        ActiveCell.Select
        ' 貼り付け開始セルの座標を保存
        ac = ActiveCell.Column
        ar = ActiveCell.Row
        ' マクロ実行中の画面描写を停止
        Application.ScreenUpdating = False
        ' 順番に画像を挿入
        For i = LBound(Filenames) To UBound(Filenames)
           
    '        objFileName = Application.GetOpenFilename _
    '            ("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "画像選択ダイアログ")

    'アクティブセルの位置に図の幅と高さを 50 ポイントに指定して画像を挿入します

            Set objShape = ActiveSheet.Shapes.AddPicture( _
            Filename:=Filenames(i), _
            LinkToFile:=False, _
            SaveWithDocument:=True, _
            Left:=Selection.Left, _
            Top:=Selection.Top, _
            Width:=msoTrue, _
            Height:=msoTrue)
    '図のサイズを元のサイズに戻します

            With objShape
                .LockAspectRatio = msoTrue   ' 縦横比維持
                ' 画像の高さをアクティブセルにあわせる
                ' 結合セルの場合でも対応
                .Height = ActiveCell.MergeArea.Height
            End With

            ' 次の貼り付け先を選択(アクティブセルにする)[例:13個下のセル]
            ActiveCell.Offset(13).Select
        Next i
       
        Application.ScreenUpdating = True
       
        ' 終了
       
        MsgBox i - 1 & "枚の画像を挿入しました", vbInformation

    End Sub

    • 移動 星 睦美 2016年7月6日 5:31 Visual Basic から
    2016年5月20日 1:13

すべての返信

  • なぜかマクロの変更をしなくても新しいレイアウトに写真が正しく挿入されます。

    正しく挿入されるいうのはどういうことでしょうか?例えば、3枚目と4枚目のあいだ(35行目あたりに)に2行追加し、追加した2行の間で改ページしたとして、1行目からマクロで画像を貼り付けた場合 1, 14, 27, 42, 55, … 行目に画像が挿入されるということでしょうか? マクロではそのような処理にはなっていないようです。行追加した後も13行の等間隔で貼り付けられるようです。

    フォーラムにスクリーンショットの画像やURLを貼り付けるには、ポイントを獲得する必要があるようです。質問者さんは現在5ポイントありますので貼り付けられるはず?

    https://social.msdn.microsoft.com/Forums/ja-JP/6644446f-8110-48a6-8d95-29050d33b7ae?forum=announceja

    2016年5月20日 1:52
  • かんばらです。

    ポイントは5ポイントあるので、EXCELの画面のスクリーンショットを貼り付けようと思ったのですが、

    「お客様のアカウントが確認できるまで、画像やリンクを貼り付けることはできません」

    というメッセージが出て投稿できないのですがどういうことでしょうか。

    以上よろしくお願いします。

    2016年5月20日 9:07
  • かんばらです。

    私のアカウントのVerifyを要求し、丸一日たちますがまだ画像を投稿できませんので申しわけありませんが言葉だけで説明させて頂きます。

    修正前は写真と写真の間なとの空行は全て2行で、また写真を貼り付けているセルは11行を結合して1つのセルとしています。ですので40と41行目のあいだを改行指定していました。

    今回1ページ目の先頭に1行、2ページ目の先頭に2行追加しました、従って先頭に空白行3行、41~44行目が改ページ指定をはさんで4行空白行となります。その他の写真と写真の間はすべて今まで通り2行、写真を貼り付けているセルを11行を結合して1つのセルとしている点すべて変更ありません。

    以上よろしくお願いします。

    2016年5月25日 1:44