エクセルで写真台帳のように1シートに写真3枚をはりつけて作成しており、3000シートぐらいあります。

これから電子納品をするにあたり、jpgデータを抽出したいのですがよいソフトはないでしょうか?
フリーソフトなら助かります。

回答の条件
  • URL必須
  • 1人3回まで
  • 13歳以上
  • 登録:2010/03/15 23:34:00
  • 終了:2010/03/17 00:23:20

ベストアンサー

id:ardarim No.5

ardarim回答回数892ベストアンサー獲得回数1422010/03/17 00:05:53

ポイント20pt

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();
id:kaji0245

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

2010/03/17 00:23:03

その他の回答(4件)

id:spyglass No.1

spyglass回答回数455ベストアンサー獲得回数292010/03/16 04:24:13

ポイント20pt

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

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

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

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

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

id:kaji0245

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

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

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

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

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

2010/03/16 10:39:26
id:v87 No.2

v87回答回数22ベストアンサー獲得回数52010/03/16 05:48:22

ポイント20pt

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

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

id:kaji0245

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

2010/03/16 10:40:00
id:taknt No.3

きゃづみぃ回答回数13537ベストアンサー獲得回数11982010/03/16 06:11:50

ポイント20pt

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

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

id:kaji0245

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

2010/03/16 10:40:10
id:SALINGER No.4

SALINGER回答回数3454ベストアンサー獲得回数9692010/03/16 11:19:21

ポイント20pt

こちらのサイトの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
id:kaji0245

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

2010/03/16 11:42:06
id:ardarim No.5

ardarim回答回数892ベストアンサー獲得回数1422010/03/17 00:05:53ここでベストアンサー

ポイント20pt

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();
id:kaji0245

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

2010/03/17 00:23:03
  • id:taknt
    ブック全体にすれば 全シート一括でできるんだけどなぁ・・・・。

    ま、3000シートだから複数ブックになるのかな?

    その場合は、ちょっとしたマクロを組めば自動化できますよ。
  • id:kaji0245
    失礼しました、シートは1枚のみでブックが多数ありました。
    >こちらのサイトのAPIを使った方法を使えばできそうなので作ってみました。
    >http://vbatips.blog37.fc2.com/blog-entry-26.html
    こちらも試してみましたが、
    以下の作業がよくわからず、先に進めませんでした(^_^;)
    >標準モジュールにコピペしてSaveJpgを実行してみてください。
    >ブック名-シート名-オートシェイプ名で名前をつけて一気に保存します。
  • id:SALINGER
    リンク先はコードを作るのに参考にしたサイトなのでリンク先のコードをそのままでは実行できません。
    VBAの使い方はこちらのサイトがわかりやすいです。
    http://www.officepro.jp/excelvba/ini/index1.html
    http://www.officepro.jp/excelvba/ini/index2.html
    http://www.officepro.jp/excelvba/ini/index3.html
    Excel2003での使い方なので、Excel2007の場合は多少違いますが、
    VBE(エディタ)を開いて、標準モジュールを追加して、回答のコードをコピペして(一部直して)
    実行するというのは変わりません。
  • id:kaji0245
    VBAの勉強をやってみます<(_ _)>

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません