Access (VBA)

Access VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10全般 : Access 2013)
レポートをJPEG変換したい
投稿日時: 21/07/15 19:50:23
投稿者: yamasho

お世話になります
 
レポートをPDF変換する方法はわかります。
 
DoCmd.OutputTo acOutputReport
 
同じようにJPEG変換することは可能でしょうか?

回答
投稿日時: 21/07/16 11:25:13
投稿者: sk

Access の組み込み機能として、レポートの JPEG 出力機能は
サポートされていません。
(それに該当する VBA のメソッドもありません)
 
どういった目的からそのようなことをなさりたいのかは不明ですが、
今のところ考えられるのは次のような方法です。
 
・レポートを PDF 形式で出力した上、PDF 編集ソフト( Adobe Acrobat など)の
 機能を用いてその PDF ファイルを JPEG 形式のファイルに出力する。
 
・JPEG 出力に対応したサードパーティー製の
 仮想プリンターからレポートを印刷する。

回答
投稿日時: 21/07/16 20:02:17
投稿者: mayu.

yamasho さんの引用:
レポートをPDF変換する方法はわかります。
同じようにJPEG変換することは可能でしょうか?

圧縮ファイルを解凍するだけで利用できるため、
skさんが回答されている手段の一つ( PDF → JPEG変換 )である
コマンドラインツール poppler をご紹介します。
http://pdf-file.nnn2.com/?p=863
 
なお、poppler の本体は 7z ファイルなので 7-zip などのツールで解凍、
poppler の言語ファイルは tar.gz で圧縮されていますが
解凍する為の tar コマンドはコマンドプロンプトから利用可能です。
例:
cd 言語ファイルのダウンロードフォルダパス
tar zxvf poppler-data-0.4.10.tar.gz
 
poppler を利用する準備が出来たら
pdftocairo か pdftoppm コマンドを使って変換を実施すればいいでしょう。
 
注意点として、poppler に含まれるコマンドは
入出力に利用するパスの文字コードが UTF-8 であるため、コード中では
コマンド実行時の文字化け対策( 入出力先パスに日本語を含まない )が必要になります。
 
Sub sample()
    Const EXE_PATH  As String = "配置した pdftocairo.exe のフルパス" '←変更
    Const PDF_PATH  As String = "出力したPDFのフルパス" '←変更
    Const OPTIONS   As String = " -jpeg "
    
    If (Len(Environ("UserName")) <> _
            LenB(StrConv(Environ("UserName"), vbFromUnicode))) Then
        MsgBox Prompt:="ログインユーザー名に" _
                      & vbNewLine _
                      & "日本語が含まれている環境は実行不可" _
             , Buttons:=vbCritical _
             , Title:="変換中止"
        Exit Sub
    End If
    
    Dim fso      As Object
    Dim src_path As String
    Dim basename As String
    Dim prefix   As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    src_path = PDF_PATH
    basename = fso.GetBaseName(PDF_PATH)
    prefix = basename
    
    If (Len(PDF_PATH) <> LenB(StrConv(PDF_PATH, vbFromUnicode))) Then
        If (Len(basename) <> LenB(StrConv(basename, vbFromUnicode))) Then
            'JPEG出力後に元のファイル名へリネームします( Rename-Itemの部分 )
            prefix = "yamasho-" & Format$(Now, "yyyymmdd_hhnnss")
        End If
        src_path = Environ("Temp") & "\" & prefix & ".pdf"
        fso.CopyFile PDF_PATH, src_path, True
    End If
    
    Dim in_arg As String
    in_arg = Chr$(34) & src_path & Chr$(34)
    
    With CreateObject("WScript.Shell")
        Dim outdir As String
        outdir = .SpecialFolders("DESKTOP") _
               & "\" _
               & "pdf_to_jpg_" _
               & Format$(Date, "yyyymmdd")
        
        If (Not fso.FolderExists(outdir)) Then
            fso.CreateFolder outdir
        End If
            
        Dim out_arg As String
        out_arg = Chr$(34) & outdir & "\" & prefix & Chr$(34)
        
        Dim command As String
        command = Chr$(34) & EXE_PATH & Chr(34) & OPTIONS & in_arg & " " & out_arg
        Rem Debug.Print command
        .Run command, 0, True
        
        If (prefix <> basename) Then
            command = "PowerShell -STA -NoProfile " _
                    & "           -ExecutionPolicy Unrestricted -Command " _
                    & "Remove-Item '" & outdir & "\" & basename & "*.jpg' -Force ; " _
                    & "Get-ChildItem '" & outdir & "' -File | " _
                    & "Rename-Item -NewName " _
                    & "    { $_.Name -replace '" & prefix & "', '" & basename & "' }"
            .Run command, 0, True
        End If
    End With
    
    If (src_path <> PDF_PATH) Then
        fso.DeleteFile src_path
    End If
    Set fso = Nothing
    MsgBox Prompt:="PDF → JPEG変換完了" _
                  & vbNewLine _
                  & "出力先: " & outdir _
         , Buttons:=vbInformation _
         , Title:="結果"
End Sub

トピックに返信