人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルで写真台帳のように1シートに写真3枚をはりつけて作成しており、3000シートぐらいあります。
これから電子納品をするにあたり、jpgデータを抽出したいのですがよいソフトはないでしょうか?
フリーソフトなら助かります。

●質問者: kaji0245
●カテゴリ:コンピュータ インターネット
✍キーワード:jpg エクセル ソフト データ フリーソフト
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● spyglass
●20ポイント

そのエクセルファイルを開きファイル→名前をつけて保存を選びます。

ファイル名を適当に、ファイルの種類をWEBページで保存します。

すると保存されたディレクトリ上にファイル名と同じフォルダが出来上がってるかと思います。

そのフォルダの中に各シートの写真が保存されています。

http://www.hatena.ne.jp/

◎質問者からの返答

なるほど、そういう方法がありますね。

>そのエクセルファイルを開きファイル→名前をつけて保存を選びます。

>ファイル名を適当に、ファイルの種類をWEBページで保存します。

これを自動化できればさらに速くなりそうです(^_^;)

ご回答ありがとうございます。


2 ● v87
●20ポイント

そのエクセルファイルを開いて、「名前を付けて保存」をします。その時に「Webページ (*.htm;*html)」で保存すると「ファイル名.html」というファイルと「ファイル名.files」というフォルダが出来てjpgデータなどはそのフォルダの中に全て抽出されて保存されます。

http://q.hatena.ne.jp/1268663637

◎質問者からの返答

ありがとうございます、参考にさせていただきます。


3 ● きゃづみぃ
●20ポイント

http://allabout.co.jp/computer/msexcel/closeup/CU20081005A/index...

HTML形式で保存すれば 画像ファイルが 出来ます。

◎質問者からの返答

ありがとうございます、参考にさせていただきます。


4 ● SALINGER
●20ポイント

こちらのサイトのAPIを使った方法を使えばできそうなので作ってみました。

http://vbatips.blog37.fc2.com/blog-entry-26.html


一つのブックに3000シートとは考えづらいので複数ブックがあるとして、

画像はオートシェイプで挿入されている場合、複数のブックのオートシェイプをjpg画像で保存するマクロです。


以下のコードで「保存先フォルダ」「ブックのあるフォルダ」の2行を実際の環境に変更して

新規のブックか画像のあるブックの一つのどちらかの標準モジュールにコピペしてSaveJpgを実行してみてください。

ブック名-シート名-オートシェイプ名で名前をつけて一気に保存します。

命名規則の変更をしたい場合やブックごとにフォルダを分けるなどにしたい場合は修正しますのでお知らせ下さい。

※画像9000だとハードディスクの空きを確認し、時間もかかると思われるので少ないファイルからテストしてみてください。


Private Type FLTIMAGE
 StructSize As Integer
 Type As Byte
 Reserved1(0 To 8) As Byte
 hImage As Long
 Reserved3(0 To 19) As Byte
End Type
Private Type FLTFILE
 Reserved1 As Integer
 Ext As String * 4
 Reserved2 As Integer
 Path As String * 260
 Reserved3 As Currency
End Type
Private Declare Function GetFilterInfo Lib _
 "C:\Program Files\Common Files\Microsoft Shared\Grphflt\JPEGIM32.FLT" _
 (ByVal Ver As Integer, ByVal Reserved As Long, _
 phMem As Long, ByVal flags As Long) As Long
Private Declare Function ExportGr Lib "JPEGIM32.FLT" _
 (ff As FLTFILE, fi As FLTIMAGE, ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" _
 (ByVal hWndNewOwner As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" _
 (ByVal uFormat As Long) As Long
Const CF_ENHMETAFILE = 14
Private Declare Function CopyEnhMetaFile Lib "gdi32" _
 Alias "CopyEnhMetaFileA" _
 (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
 (ByVal hemf As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" _
 (ByVal hMem As Long) As Long

Function SaveClipToJpg(img As Shape, Path As String) As Boolean
 Dim tFltImg As FLTIMAGE
 Dim tFltFile As FLTFILE
 Dim hemf As Long
 Dim hMem As Long
 
 SaveClipToJpg = False
 
  'クリップボードにコピー
 img.CopyPicture
  'Selection.CopyPicture
 If OpenClipboard(0) Then
 hemf = CopyEnhMetaFile( _
 GetClipboardData(CF_ENHMETAFILE), _
 vbNullString)
 CloseClipboard
 End If
 If hemf = 0 Then Exit Function
 
  ' パラメータ設定
 tFltFile.Path = Path & vbNullChar
 With tFltImg
 .StructSize = LenB(tFltImg)
 .Type = 1
 .hImage = hemf
 End With
  ' フィルタ呼び出し
 If GetFilterInfo(3, 0, hMem, &H10000) And &H10 Then
 If ExportGr(tFltFile, tFltImg, hMem) = 0 Then
 SaveClipToJpg = True
 End If
 End If
 
 If hMem Then GlobalFree hMem
 DeleteEnhMetaFile hemf

End Function

Sub SaveJpg()
 Const SavePath As String = "C:\Documents and Settings\hogehoge\デスクトップ\test"  '保存先フォルダ
 Const BooksPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\test" 'ブックのあるフォルダ
 Dim f As Boolean
 Dim shp As Shape
 Dim ws As Worksheet
 Dim suc As Integer
 Dim fai As Integer
 Dim FSO
 Dim myFile
 
 Set FSO = CreateObject("Scripting.FileSystemObject")

 For Each myFile In FSO.GetFolder(BooksPath).Files
 If FSO.GetExtensionName(myFile) = "xls" Or FSO.GetExtensionName(myFile) = "xlsx" Then
 Workbooks.Open myFile.Path
 For Each ws In Workbooks(myFile.Name).Worksheets
 For Each shp In ws.Shapes
 If shp.Type = msoPicture Then
 f = SaveClipToJpg(shp, SavePath & "\" & FSO.GetBaseName(myFile) & "-" & ws.Name & "-" & shp.Name & ".jpg")
 If f Then
 suc = suc + 1
 Else
 fai = fai + 1
 End If
 End If
 Next
 Next
 Workbooks(myFile.Name).Close
 End If
 Next
 
 MsgBox "成功:" & suc & vbNewLine & "失敗:" & fai
 
 Set FSO = Nothing
End Sub
◎質問者からの返答

これはすごい!早速やってみます<(_ _)>


5 ● ardarim
●20ポイント ベストアンサー

IrfanViewをインストールする必要がありますが、以下のスクリプトを書いてみました。

xlsファイルがあるフォルダに適当なファイル名.jsで保存し、コマンドプロンプトから「cscript ファイル名.js」で実行してください。

画像ファイルは xlsファイル名_シート名_画像名.jpg という名前で保存されます。

var wsh = WScript.createObject("WScript.Shell");
var fso = WScript.createObject("Scripting.FileSystemObject");
var excel = WScript.createObject("Excel.Application");

// IrfanViewをインストールした場所(ディレクトリ区切りの¥は2つ書く必要があります)
var irfanPath = "c:¥¥program files¥¥irfanview¥¥i_view32.exe";

var msoAutomationSecurityForceDisable = 3;
var msoPicture = 13;

// マクロOFF
excel.automationSecurity = msoAutomationSecurityForceDisable;

// このスクリプトのディレクトリを取得
fo = fso.getFile(WScript.scriptFullName).parentFolder;

fc = new Enumerator(fo.files);
for( ; !fc.atEnd(); fc.moveNext()){
 fn = new String(fc.item());
 if(fn.match(/.xls$/)){
 WScript.echo(fn);
 wb = excel.workbooks.open(fn, false, true);
 sc = new Enumerator(wb.worksheets);
 for( ; !sc.atEnd(); sc.moveNext()){
 sht = sc.item();
 WScript.echo("[" + sht.name + "]");
 spc = new Enumerator(sht.shapes);
 for( ; !spc.atEnd(); spc.moveNext()){
 if(spc.item().type == msoPicture){
 WScript.echo("image=" + spc.item().name);
 jpgName = fo.path + "¥¥" + wb.name + "_" + sht.name + "_" + spc.item().name + ".jpg";
 spc.item().copy();
 wsh.run("¥"" + irfanPath + "¥" /clippaste /convert=¥"" + jpgName + "¥"", 7, true);
 }
 }
 }
 wb.close(false);
 }
}

excel.quit();
◎質問者からの返答

すばらしいです♪早速試してみます、ありがとうございます<(_ _)>

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ