Skip to content

Instantly share code, notes, and snippets.

@HaruhiroTakahashi

HaruhiroTakahashi/Module.bas

Last active October 14, 2015 01:02
Show Gist options
  • Save HaruhiroTakahashi/45d314b2a29fa049740d to your computer and use it in GitHub Desktop.
Save HaruhiroTakahashi/45d314b2a29fa049740d to your computer and use it in GitHub Desktop.
Download ZIP
Excel画像貼り付け
Raw
data_copy.bat
#set MyPath(変数)の1～4の4箇所のパスを変更する
#一番下の実機確認映像のパスを変更する
mkdir data
#基準のFROMのデバック結果のフルパスに変更(C:\Users～\AnalysisResult　までを変更）
set MyPath1=C:\Users\SCD2010018\Desktop\141224_開確試向け(本番)\501_Debug\debug後\AnalysisResult(1102)
robocopy %MyPath1%\AnalysisResult\00_Synthesis %USERPROFILE%\Desktop\画像貼付バッチ\data\00_Synthesis_After
robocopy %MyPath1%\AnalysisResult\12_Map\Image %USERPROFILE%\Desktop\画像貼付バッチ\data\12_Map_After
robocopy %MyPath1%\AnalysisResult\13_CourseNone %USERPROFILE%\Desktop\画像貼付バッチ\data\13_CourseNone_After
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\000
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\001
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\002
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\003
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\004
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\005
set MyPath2=C:\Users\SCD2010018\Desktop\141224_開確試向け(本番)\501_Debug\debug後\AnalysisResult(1102)\AnalysisResult\14_CourseOnly
copy %MyPath2%\000\CourseOnly_000_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\000\CourseOnly_000_00000_000.bmp
copy %MyPath2%\001\CourseOnly_001_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\001\CourseOnly_001_00000_000.bmp
copy %MyPath2%\002\CourseOnly_002_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\002\CourseOnly_002_00000_000.bmp
copy %MyPath2%\003\CourseOnly_003_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\003\CourseOnly_003_00000_000.bmp
copy %MyPath2%\004\CourseOnly_004_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\004\CourseOnly_004_00000_000.bmp
copy %MyPath2%\005\CourseOnly_005_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\005\CourseOnly_005_00000_000.bmp
copy %MyPath2%\000\CourseOnly_000_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\000\CourseOnly_000_00000_010.bmp
copy %MyPath2%\001\CourseOnly_001_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\001\CourseOnly_001_00000_010.bmp
copy %MyPath2%\002\CourseOnly_002_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\002\CourseOnly_002_00000_010.bmp
copy %MyPath2%\003\CourseOnly_003_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\003\CourseOnly_003_00000_010.bmp
copy %MyPath2%\004\CourseOnly_004_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\004\CourseOnly_004_00000_010.bmp
copy %MyPath2%\005\CourseOnly_005_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\005\CourseOnly_005_00000_010.bmp
copy %MyPath2%\000\CourseOnly_000_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\000\CourseOnly_000_00000_025.bmp
copy %MyPath2%\001\CourseOnly_001_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\001\CourseOnly_001_00000_025.bmp
copy %MyPath2%\002\CourseOnly_002_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\002\CourseOnly_002_00000_025.bmp
copy %MyPath2%\003\CourseOnly_003_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\003\CourseOnly_003_00000_025.bmp
copy %MyPath2%\004\CourseOnly_004_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\004\CourseOnly_004_00000_025.bmp
copy %MyPath2%\005\CourseOnly_005_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\005\CourseOnly_005_00000_025.bmp
copy %MyPath2%\000\CourseOnly_000_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\000\CourseOnly_000_00000_045.bmp
copy %MyPath2%\001\CourseOnly_001_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\001\CourseOnly_001_00000_045.bmp
copy %MyPath2%\002\CourseOnly_002_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\002\CourseOnly_002_00000_045.bmp
copy %MyPath2%\003\CourseOnly_003_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\003\CourseOnly_003_00000_045.bmp
copy %MyPath2%\004\CourseOnly_004_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\004\CourseOnly_004_00000_045.bmp
copy %MyPath2%\005\CourseOnly_005_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\005\CourseOnly_005_00000_045.bmp
copy %MyPath2%\000\CourseOnly_000_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\000\CourseOnly_000_00000_065.bmp
copy %MyPath2%\001\CourseOnly_001_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\001\CourseOnly_001_00000_065.bmp
copy %MyPath2%\002\CourseOnly_002_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\002\CourseOnly_002_00000_065.bmp
copy %MyPath2%\003\CourseOnly_003_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\003\CourseOnly_003_00000_065.bmp
copy %MyPath2%\004\CourseOnly_004_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\004\CourseOnly_004_00000_065.bmp
copy %MyPath2%\005\CourseOnly_005_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\005\CourseOnly_005_00000_065.bmp
copy %MyPath2%\000\CourseOnly_000_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\000\CourseOnly_000_00000_080.bmp
copy %MyPath2%\001\CourseOnly_001_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\001\CourseOnly_001_00000_080.bmp
copy %MyPath2%\002\CourseOnly_002_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\002\CourseOnly_002_00000_080.bmp
copy %MyPath2%\003\CourseOnly_003_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\003\CourseOnly_003_00000_080.bmp
copy %MyPath2%\004\CourseOnly_004_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\004\CourseOnly_004_00000_080.bmp
copy %MyPath2%\005\CourseOnly_005_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\005\CourseOnly_005_00000_080.bmp
copy %MyPath2%\000\CourseOnly_000_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\000\CourseOnly_000_00000_090.bmp
copy %MyPath2%\001\CourseOnly_001_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\001\CourseOnly_001_00000_090.bmp
copy %MyPath2%\002\CourseOnly_002_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\002\CourseOnly_002_00000_090.bmp
copy %MyPath2%\003\CourseOnly_003_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\003\CourseOnly_003_00000_090.bmp
copy %MyPath2%\004\CourseOnly_004_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\004\CourseOnly_004_00000_090.bmp
copy %MyPath2%\005\CourseOnly_005_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_After\005\CourseOnly_005_00000_090.bmp
#基準のFROMのデバック結果のフルパスに変更(C:\Users～\AnalysisResult　までを変更）
set MyPath3=C:\Users\SCD2010018\Desktop\4F45Z_before\1020
robocopy %MyPath3%\AnalysisResult\00_Synthesis %USERPROFILE%\Desktop\画像貼付バッチ\data\00_Synthesis_Before
robocopy %MyPath3%\AnalysisResult\12_Map\Image %USERPROFILE%\Desktop\画像貼付バッチ\data\12_Map_Before
robocopy %MyPath3%\AnalysisResult\13_CourseNone %USERPROFILE%\Desktop\画像貼付バッチ\data\13_CourseNone_Before
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\000
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\001
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\002
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\003
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\004
mkdir %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\005
set MyPath4=C:\Users\SCD2010018\Desktop\4F45Z_before\1020\AnalysisResult\14_CourseOnly
copy %MyPath4%\000\CourseOnly_000_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\000\CourseOnly_000_00000_000.bmp
copy %MyPath4%\001\CourseOnly_001_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\001\CourseOnly_001_00000_000.bmp
copy %MyPath4%\002\CourseOnly_002_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\002\CourseOnly_002_00000_000.bmp
copy %MyPath4%\003\CourseOnly_003_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\003\CourseOnly_003_00000_000.bmp
copy %MyPath4%\004\CourseOnly_004_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\004\CourseOnly_004_00000_000.bmp
copy %MyPath4%\005\CourseOnly_005_00000_000.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\005\CourseOnly_005_00000_000.bmp
copy %MyPath4%\000\CourseOnly_000_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\000\CourseOnly_000_00000_010.bmp
copy %MyPath4%\001\CourseOnly_001_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\001\CourseOnly_001_00000_010.bmp
copy %MyPath4%\002\CourseOnly_002_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\002\CourseOnly_002_00000_010.bmp
copy %MyPath4%\003\CourseOnly_003_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\003\CourseOnly_003_00000_010.bmp
copy %MyPath4%\004\CourseOnly_004_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\004\CourseOnly_004_00000_010.bmp
copy %MyPath4%\005\CourseOnly_005_00000_010.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\005\CourseOnly_005_00000_010.bmp
copy %MyPath4%\000\CourseOnly_000_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\000\CourseOnly_000_00000_025.bmp
copy %MyPath4%\001\CourseOnly_001_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\001\CourseOnly_001_00000_025.bmp
copy %MyPath4%\002\CourseOnly_002_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\002\CourseOnly_002_00000_025.bmp
copy %MyPath4%\003\CourseOnly_003_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\003\CourseOnly_003_00000_025.bmp
copy %MyPath4%\004\CourseOnly_004_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\004\CourseOnly_004_00000_025.bmp
copy %MyPath4%\005\CourseOnly_005_00000_025.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\005\CourseOnly_005_00000_025.bmp
copy %MyPath4%\000\CourseOnly_000_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\000\CourseOnly_000_00000_045.bmp
copy %MyPath4%\001\CourseOnly_001_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\001\CourseOnly_001_00000_045.bmp
copy %MyPath4%\002\CourseOnly_002_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\002\CourseOnly_002_00000_045.bmp
copy %MyPath4%\003\CourseOnly_003_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\003\CourseOnly_003_00000_045.bmp
copy %MyPath4%\004\CourseOnly_004_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\004\CourseOnly_004_00000_045.bmp
copy %MyPath4%\005\CourseOnly_005_00000_045.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\005\CourseOnly_005_00000_045.bmp
copy %MyPath4%\000\CourseOnly_000_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\000\CourseOnly_000_00000_065.bmp
copy %MyPath4%\001\CourseOnly_001_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\001\CourseOnly_001_00000_065.bmp
copy %MyPath4%\002\CourseOnly_002_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\002\CourseOnly_002_00000_065.bmp
copy %MyPath4%\003\CourseOnly_003_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\003\CourseOnly_003_00000_065.bmp
copy %MyPath4%\004\CourseOnly_004_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\004\CourseOnly_004_00000_065.bmp
copy %MyPath4%\005\CourseOnly_005_00000_065.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\005\CourseOnly_005_00000_065.bmp
copy %MyPath4%\000\CourseOnly_000_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\000\CourseOnly_000_00000_080.bmp
copy %MyPath4%\001\CourseOnly_001_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\001\CourseOnly_001_00000_080.bmp
copy %MyPath4%\002\CourseOnly_002_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\002\CourseOnly_002_00000_080.bmp
copy %MyPath4%\003\CourseOnly_003_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\003\CourseOnly_003_00000_080.bmp
copy %MyPath4%\004\CourseOnly_004_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\004\CourseOnly_004_00000_080.bmp
copy %MyPath4%\005\CourseOnly_005_00000_080.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\005\CourseOnly_005_00000_080.bmp
copy %MyPath4%\000\CourseOnly_000_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\000\CourseOnly_000_00000_090.bmp
copy %MyPath4%\001\CourseOnly_001_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\001\CourseOnly_001_00000_090.bmp
copy %MyPath4%\002\CourseOnly_002_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\002\CourseOnly_002_00000_090.bmp
copy %MyPath4%\003\CourseOnly_003_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\003\CourseOnly_003_00000_090.bmp
copy %MyPath4%\004\CourseOnly_004_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\004\CourseOnly_004_00000_090.bmp
copy %MyPath4%\005\CourseOnly_005_00000_090.bmp %USERPROFILE%\Desktop\画像貼付バッチ\data\14_CourseOnly_Before\005\CourseOnly_005_00000_090.bmp
#作成したFROMの実機取得映像のフルパスに変更(C:\Users～\v1102　までを変更）
robocopy C:\Users\SCD2010018\Desktop\141224_開確試向け(本番)\003_テスト確認物\150929_実機取得映像\v1102 %USERPROFILE%\\Desktop\画像貼付バッチ\data\実機取得映像
Raw
Module.bas
Attribute VB_Name = "MMCTestSpecificationsModule"
'*************************************************************************************
'
' 画像削除設定 ＝ delpic.setdelshape(①, ②, ③, ④)
' 画像貼付設定 ＝ setpic.setpicture(⑤, ②, ⑥, ④, ⑦, ⑧)
'
' ①画像削除開始位置（列）【ここだけ文字で指定すること。 例："A"】
' ②画像貼り付け、削除開始位置（行）
' ③削除終了位置(列)
' ④開始位置以降の画像貼り付け、削除間隔（行）
' ⑤画像貼り付け開始位置（列）
' ⑥1ページ内写真枚数
' ⑦画像横幅（ポイント）
' ⑧画像縦幅（ポイント）
'
' 1ポイントの大きさが1/72インチです。
' 1インチは25.4mmなので、計算上、1ポイントあたり「25.4 / 72」mmになります。
' エクセル上で横10cmの画像を貼りたい場合は以下計算によりポイント数を算出できます｡
'
' 100mm / (25.4mm / 72インチ)　= 283ポイント
'
'
' もしくは画像を貼り付けたいシートの「列(行)の幅」の値を調べて、以下のように概算値を使うと
' セルの大きさに近い画像を貼り付けることができます。（幅の値の小数点は切り捨て推奨）
'
' 列(ポイント) = 「列の幅」× 6
' 行(ポイント）= 「行の幅」
'
'*************************************************************************************
'1-9 評価映像Before
Sub one_9_MAP_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 3, 29, 2)
Call setpic.setpicture(4, 3, 14, 2, 600, 360)
End Sub
'1-9 評価映像After
Sub one_9_MAP_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 4, 30, 2)
Call setpic.setpicture(4, 4, 14, 2, 600, 360)
End Sub
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'1-10 ソフト軌跡画像Before
Sub one_10_Locus_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 3, 59, 2)
Call setpic.setpicture(4, 3, 29, 2, 600, 360)
End Sub
'1-10 ソフト軌跡画像After
Sub one_10_Locus_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 4, 60, 2)
Call setpic.setpicture(4, 4, 29, 2, 600, 360)
End Sub
'1-10 MAP映像Before
Sub one_10_MAP_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("E", 3, 59, 2)
Call setpic.setpicture(5, 3, 29, 2, 600, 360)
End Sub
'1-10 MAP映像After
Sub one_10_MAP_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("E", 4, 60, 2)
Call setpic.setpicture(5, 4, 29, 2, 600, 360)
End Sub
'1-10 評価映像(重畳)Before
Sub one_10_Superimpose_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("F", 3, 59, 2)
Call setpic.setpicture(6, 3, 29, 2, 600, 360)
End Sub
'1-10 評価映像(重畳)After
Sub one_10_Superimpose_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("F", 4, 60, 2)
Call setpic.setpicture(6, 4, 29, 2, 600, 360)
End Sub
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'1-11 -45度画像Before
Sub one_11_M45degrees_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("C", 4, 14, 2)
Call setpic.setpicture(3, 4, 6, 2, 600, 360)
End Sub
'1-11 -45度画像After
Sub one_11_M45degrees_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("C", 5, 15, 2)
Call setpic.setpicture(3, 5, 6, 2, 600, 360)
End Sub
'1-11 -35度映像Before
Sub one_11_M35degrees_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 4, 14, 2)
Call setpic.setpicture(4, 4, 6, 2, 600, 360)
End Sub
'1-11 -35度映像After
Sub one_11_M35degrees_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 5, 15, 2)
Call setpic.setpicture(4, 5, 6, 2, 600, 360)
End Sub
'1-11 -20度映像Before
Sub one_11_M20degrees_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("E", 4, 14, 2)
Call setpic.setpicture(5, 4, 6, 2, 600, 360)
End Sub
'1-11 -20度映像After
Sub one_11_M20degrees_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("E", 5, 15, 2)
Call setpic.setpicture(5, 5, 6, 2, 600, 360)
End Sub
'1-11 0度映像Before
Sub one_11_0degrees_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("F", 4, 14, 2)
Call setpic.setpicture(6, 4, 6, 2, 600, 360)
End Sub
'1-11 0度MAP映像After
Sub one_11_0degrees_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("F", 5, 15, 2)
Call setpic.setpicture(6, 5, 6, 2, 600, 360)
End Sub
'1-11 20度映像Before
Sub one_11_P20degrees_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("G", 4, 14, 2)
Call setpic.setpicture(7, 4, 6, 2, 600, 360)
End Sub
'1-11 20度映像After
Sub one_11_P20degrees_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("G", 5, 15, 2)
Call setpic.setpicture(7, 5, 6, 2, 600, 360)
End Sub
'1-11 35度映像Before
Sub one_11_P35degrees_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("H", 4, 14, 2)
Call setpic.setpicture(8, 4, 6, 2, 600, 360)
End Sub
'1-11 35度映像After
Sub one_11_P35degrees_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("H", 5, 15, 2)
Call setpic.setpicture(8, 5, 6, 2, 600, 360)
End Sub
'1-11 45度映像Before
Sub one_11_P45degrees_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("I", 4, 14, 2)
Call setpic.setpicture(9, 4, 6, 2, 600, 360)
End Sub
'1-11 45度映像After
Sub one_11_P45degrees_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("I", 5, 15, 2)
Call setpic.setpicture(9, 5, 6, 2, 600, 360)
End Sub
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'1-11 MAP映像Before
Sub one_11_MAP_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("J", 4, 14, 2)
Call setpic.setpicture(10, 4, 6, 2, 600, 360)
End Sub
'1-11 MAP映像After
Sub one_11_MAP_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("J", 5, 15, 2)
Call setpic.setpicture(10, 5, 6, 2, 600, 360)
End Sub
'1-11 マイナス度評価画像Before
Sub one_11_Evaluation_Minus_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("K", 4, 14, 2)
Call setpic.setpicture(11, 4, 6, 2, 600, 360)
End Sub
'1-11 マイナス度評価画像After
Sub one_11_Evaluation_Minus_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("K", 5, 15, 2)
Call setpic.setpicture(11, 5, 6, 2, 600, 360)
End Sub
'1-11 プラス度評価画像Before
Sub one_11_Evaluation_Plus_Before()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("L", 4, 14, 2)
Call setpic.setpicture(12, 4, 6, 2, 600, 360)
End Sub
'1-11 プラス度評価画像After
Sub one_11_Evaluation_Plus_After()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("L", 5, 15, 2)
Call setpic.setpicture(12, 5, 6, 2, 600, 360)
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'3-1 表示確認DOP
Sub three_1_Display_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("C", 7, 14, 2)
Call setpic.setpicture(3, 7, 4, 2, 800, 600)
End Sub
'3-1 表示確認Mirror
Sub three_1_Display_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 7, 14, 2)
Call setpic.setpicture(4, 7, 4, 2, 800, 600)
End Sub
'3-1 キャリブNG画像確認DOP
Sub three_1_NG_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("G", 7, 14, 2)
Call setpic.setpicture(7, 7, 4, 2, 800, 600)
End Sub
'3-1 キャリブNG画像確認Mirror
Sub three_1_NG_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("H", 7, 14, 2)
Call setpic.setpicture(8, 7, 4, 2, 800, 600)
End Sub
'3-1 カメラ故障時マスク確認フロントトップDOP
Sub three_1_Malfunction_Front_Top_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("C", 18, 24, 2)
Call setpic.setpicture(3, 18, 4, 2, 800, 600)
End Sub
'3-1 カメラ故障時マスク確認フロントトップMirror
Sub three_1_Malfunction_Front_Top_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 18, 24, 2)
Call setpic.setpicture(4, 18, 4, 2, 800, 600)
End Sub
'3-1 カメラ故障時マスク確認フロントサイドDOP
Sub three_1_Malfunction_Front_Side_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("G", 20, 22, 2)
Call setpic.setpicture(7, 20, 4, 2, 800, 600)
End Sub
'3-1 カメラ故障時マスク確認フロントサイドMirror
Sub three_1_Malfunction_Front_Side_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("H", 20, 22, 2)
Call setpic.setpicture(8, 20, 4, 2, 800, 600)
End Sub
'3-1 カメラ故障時マスク確認リアトップDOP
Sub three_1_Malfunction_Rear_Top_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("C", 29, 35, 2)
Call setpic.setpicture(3, 29, 4, 2, 800, 600)
End Sub
'3-1 カメラ故障時マスク確認リアトップMirror
Sub three_1_Malfunction_Rear_Top_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 29, 35, 2)
Call setpic.setpicture(4, 29, 4, 2, 800, 600)
End Sub
'3-1 カメラ故障時マスク確認リアサイドDOP
Sub three_1_Malfunction_Rear_Side_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("G", 29, 31, 2)
Call setpic.setpicture(7, 29, 4, 2, 800, 600)
End Sub
'3-1 カメラ故障時マスク確認リアサイドMirror
Sub three_1_Malfunction_Rear_Side_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("H", 29, 31, 2)
Call setpic.setpicture(8, 29, 4, 2, 800, 600)
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'3-2 工場キャリブ前DOP
Sub three_2_Calib_Offline_Before_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("C", 7, 19, 4)
Call setpic.setpicture(3, 7, 4, 4, 800, 600)
End Sub
'3-2 工場キャリブ前Mirror
Sub three_2_Calib_Offline_Before_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("C", 9, 21, 4)
Call setpic.setpicture(3, 9, 4, 4, 800, 600)
End Sub
'3-2 工場キャリブ後DOP
Sub three_2_Calib_Offline_After_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 7, 19, 4)
Call setpic.setpicture(4, 7, 4, 4, 800, 600)
End Sub
'3-2 工場キャリブ後Mirror
Sub three_2_Calib_Offline_After_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("D", 9, 21, 4)
Call setpic.setpicture(4, 9, 4, 4, 800, 600)
End Sub
'3-2 販社キャリブ前DOP
Sub three_2_Calib_Dealer_Before_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("E", 7, 19, 4)
Call setpic.setpicture(5, 7, 4, 4, 800, 600)
End Sub
'3-2 販社キャリブ前Mirror
Sub three_2_Calib_Dealer_Before_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("E", 9, 21, 4)
Call setpic.setpicture(5, 9, 4, 4, 800, 600)
End Sub
'3-2 販社キャリブ後DOP
Sub three_2_Calib_Dealer_After_DOP()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("F", 7, 19, 4)
Call setpic.setpicture(6, 7, 4, 4, 800, 600)
End Sub
'3-2 販社キャリブ後Mirror
Sub three_2_Calib_Dealer_After_Mirror()
Dim delpic As New SetPictures
Dim setpic As New SetPictures
Call delpic.setdelshape("F", 9, 21, 4)
Call setpic.setpicture(6, 9, 4, 4, 800, 600)
End Sub
Raw
SetPictures.cls
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "SetPictures"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' プロパティ
'
'
' Private ROWS_OF_PAGE As Integer '1ページの行数(ページ間オフセット)
' Private COLUMNS_OF_PAGE As Integer '1ページの列数
Private FIRST_ROWINDEX As Integer '一番最初に写真貼付する行(Row)
Private PICTURE_SET_COLUMN As Integer '写真貼付けセル列番号
Private PICTURES_ON_PAGE As Integer '1ページにおける写真枚数
Private PICTURE_OFFSET As Integer 'ページ内の写真間のオフセット
Private PICTURE_WIDTH As Integer '写真横サイズ(ポイント)
Private PICTURE_HEIGHT As Integer '写真縦サイズ(ポイント)
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Sub setpicture(ByVal picturesetcolumn As Integer, _
ByVal firstrowindex As Integer, _
ByVal picturesonpage As Integer, _
ByVal pictureoffset As Integer, _
ByVal picturewidth As Integer, _
ByVal pictureheight As Integer)
' ByVal rowsofpage As Integer, _
' ByVal columnsofpage As Integer, _
' ROWS_OF_PAGE = rowsofpage
' COLUMNS_OF_PAGE = columnsofpage
FIRST_ROWINDEX = firstrowindex
PICTURE_SET_COLUMN = picturesetcolumn
PICTURES_ON_PAGE = picturesonpage
PICTURE_OFFSET = pictureoffset
PICTURE_WIDTH = picturewidth
PICTURE_HEIGHT = pictureheight
'■ PICTURE_WIDTH,PICTURE_HEIGHT ポイント計算方法
' 25.4mm / 72 * 400ポイント = 141mm
' 100mmのポイント = 100mm / (25.4mm / 72) = 283
Dim folderpath As String
Dim filename As String
Dim total_picture As Integer '写真の総枚数
Dim total_page As Integer '貼付時の総ページ
Dim MyRange As Range
Dim rowindex As Integer
Dim ErrMsgSkip As Boolean, エラーメッセージ表示フラグ
' Call DelShapes '既存の写真削除
folderpath = GetFolderPath 'フォルダーパス取得
Application.ScreenUpdating = False
total_picture = Count_Picture(folderpath)
total_page = TotalPage(total_picture, PICTURES_ON_PAGE)
filename = Dir(folderpath & "\*.*", vbNormal)
' On Error Resume Nextでエラー1004メッセージを別表示化
If folderpath = NoImages Then
On Error Resume Next
MsgBox "キャンセルが選択されました。" & vbCrLf & "選択した項目に貼られている画像はシートから削除されます。"
Else
For i = 0 To total_page - 1
rowindex = ROWS_OF_PAGE * i + FIRST_ROWINDEX
For j = 0 To PICTURES_ON_PAGE - 1
If filename <> "" Then
Set MyRange = Cells(rowindex + PICTURE_OFFSET * j, PICTURE_SET_COLUMN)
Call processing_setpicture(MyRange, folderpath & "\" & filename, PICTURE_WIDTH, PICTURE_HEIGHT)
filename = Dir()
End If
Next
Next
End If
' Call SetPrintArea(total_page) 'プリントエリア設定
Application.ScreenUpdating = True
End Sub
'********************************************
'
' 画像データの削除
'
'********************************************
Public Sub setdelshape(ByVal Column_str As String, _
ByVal start_row As Long, _
ByVal end_row As Long, _
ByVal pictureoffset As Long)
Dim Shp As Object
Dim r As Range, Target As Range
For row = start_row To end_row Step pictureoffset '②行目から③行目までを(④-1)行飛ばしながらセル範囲を見る
Set Target = Range(Column_str & row)
For Each Shp In Target.Parent.Shapes
Set r = Range(Shp.TopLeftCell, Shp.BottomRightCell)
If Not Intersect(r, Target) Is Nothing Then '指定したセル範囲内に画像が乗ってあれば、それを削除する
Shp.Delete
End If
' Set r = Nothing
Next
' Set Target = Nothing
Next row
End Sub
'/////////////////////////////////////////////////////
'
' 開くファイルのフォルダパスを取得する
'
'/////////////////////////////////////////////////////
Private Function GetFolderPath() As String
Dim obj_F_Path As Object
Set obj_F_Path = CreateObject("Shell.Application").browseforfolder(0, "読み込みたい画像フォルダを指定。", 0)
If Not obj_F_Path Is Nothing Then
GetFolderPath = obj_F_Path.items.Item.Path
Else
GetFolderPath = NoImages
End If
Set obj_F_Path = Nothing
End Function
'//////////////////////////////////////////////////////
'
' 総ファイル数のカウント処理
'
' folderpath フォルダーのパス
'
'//////////////////////////////////////////////////////
Private Function Count_Picture(ByVal folderpath As String)
Dim filename As String
Dim count As Integer
Dim total_page As Integer
filename = Dir(folderpath & "\*.*", vbNormal)
Do While filename <> ""
count = count + 1
filename = Dir()
Loop
Count_Picture = count
End Function
'//////////////////////////////////////////////////////
'
' 総ページ数の算出
'
' pic_count 写真枚数
' picture 1ページにおける写真枚数
'
'//////////////////////////////////////////////////////
Private Function TotalPage(ByVal pic_count As Integer, ByVal picture) As Integer
Select Case pic_count Mod picture
Case 0
TotalPage = Fix(pic_count / picture)
Case Is >= 1
TotalPage = Fix(pic_count / picture) + 1
Case Else
End Select
End Function
'************************************************
'
' 画像データを整形して貼り付ける
'
' MyRange 貼付けするセルレンジ
' filepath 貼付けするファイルのパス
'
'************************************************
Private Sub processing_setpicture(ByVal MyRange As Range, ByVal filepath As String, ByVal pic_width As Integer, ByVal pic_height As Integer)
ActiveSheet.Shapes.AddPicture filepath, False, True, MyRange.Left, MyRange.Top, pic_width, pic_height
End Sub
'*********************************************
'
' 印刷ページを自動設定
'
' total_page 総ページ数
'
'*********************************************
'
'Private Sub SetPrintArea(ByVal total_page As Integer)
'
' ActiveSheet.PageSetup.PrintArea = Range(Cells(1, "A"), Cells(total_page * ROWS_OF_PAGE, COLUMNS_OF_PAGE)).Address
'
'End Sub
Raw
図の振り分け例.bat
mkdir %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After
cd ../.\data\12_Map_After
copy MAP_000_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\001.bmp
copy MAP_001_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\002.bmp
copy MAP_002_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\003.bmp
copy MAP_003_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\004.bmp
copy MAP_004_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\005.bmp
copy MAP_005_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\006.bmp
copy MAP_006_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\007.bmp
copy MAP_007_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\008.bmp
copy MAP_008_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\009.bmp
copy MAP_009_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\010.bmp
copy MAP_010_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\011.bmp
copy MAP_011_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\012.bmp
copy MAP_012_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\013.bmp
copy MAP_013_00000_000.bmp %USERPROFILE%\Desktop\@テスト仕様書画像\1-9\1-9_After\014.bmp
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment