エクセル

フォルダ内の画像を張り付ける(Excel2007対応)

フォルダ内の画像を一定間隔でExcelのシートに貼り付ける

実行イメージ

マクロ
Sub 画像取込()

    Dim FindFiles As String

    Search_Drive = "G:"
    Search_Dir = "画像"
    Search_FileType = "jpg"

    画像高 = 241
    画像幅 = 323
    横間隔 = 178
    縦間隔 = 20
    縦頁間隔 = 196
    左位置 = 17
    上余白 = 85

    Search_Count = 0
    FindFiles = Dir(Search_Drive & "\" & Search_Dir & "\" & "\*." & Search_FileType)

    Do While FindFiles <> ""
        Search_Count = Search_Count + 1
        FindFiles = Dir()
    Loop

    If Search_Count > 18 Then
        MsgBox "一括取込内のファイルは18個以下にしてください。"
        Exit Sub
    End If

    RTN = MsgBox(Search_Count & "個のファイルを取り込みますか?", vbYesNo)
    If RTN = 7 Then
       Exit Sub
    End If

    Cells(5, 2).Select
    FindFiles = Dir(Search_Drive & "\" & Search_Dir & "\" & "\*." & Search_FileType)
    EditCount = 0
    Do While FindFiles <> ""
        If EditCount Mod 6 = 0 And EditCount > 0 Then
           左位置 = 左位置 + 画像幅 + 横間隔
        End If
        
        If EditCount Mod 6 > 2 Then
            上位置 = (EditCount Mod 6) * 画像高 + (EditCount Mod 6) * 縦間隔 + 縦頁間隔
        Else
            上位置 = (EditCount Mod 6) * 画像高 + (EditCount Mod 6) * 縦間隔 + 上余白
        End If

        With ActiveSheet.Pictures.Insert(Search_Drive & "\" & Search_Dir & "\" & FindFiles)
            .ShapeRange.LockAspectRatio = msoTrue
            .ShapeRange.Height = 画像高
            .ShapeRange.Width = 画像幅
            .ShapeRange.Top = 上位置
            .ShapeRange.Left = 左位置
        End With

        EditCount = EditCount + 1
        FindFiles = Dir()
    Loop
End Sub


      Document-Folder          一覧
HP-UX
HULFT
JAVA
JP1
JavaScript
Linux
MAC
PHP
Perl
Python
Ruby
SOA
Solaris
Unix全般
Windows
XML
エクセル
スタイルシート
セキュリティー
データベース
ネットワーク
パソコン
ブラウザ
プログラム構文
仮想化
          RSS-Folder
ニュース
   アットマーク・アイティ(@IT)
   シンクイット(ThinkIT)
   インターネットコム
   インターネットウォッチ
   日経IT-Pro
   日経パソコン
   CNET Japan
   ZD-NetJapan
   MYCOM
   RBB-Today
ベンダー
   日本IBM
   日本HP
   サンマイクロシステムズ
   NEC
   富士通
   日立
ソフトウェア
   マイクロソフト
   トレンドマイクロ
   オラクル
   サイボウズ
   Mozilla
   野村総合研究所
   (その他ソフトウェア企業)
更新履歴 一覧
 07/08 PERF
プログラム構文
 07/07 PERF
プログラム構文
 06/25 オブジェクトプログラミング2
Perl>サンプル
 07/12 クローン作成
仮想化>vCenter
 07/12 vyatta設定
ネットワーク>vyatta
 07/12 vyattaインストール
ネットワーク>vyatta
 07/12 リポジトリサーバ
Linux>サーバ構築
 07/05 VMwareのインストール
仮想化>VMware
 07/05 PXEブート
仮想化>KVM
 07/01 DHCPでのPXEブート
仮想化>KVM
 06/27 qcow2仮想DISK作成
仮想化>KVM
 06/13 NWの設定
仮想化>VMwareEsxi
 06/13 IPアドレスの変更
仮想化>VMwareEsxi
 06/12 自動ssh
Unix全般>シェル>Bash
 06/12 diffプログラミング
Python
Google