Accessのレポート出力時、画像一部印刷されない時の対処法

Accessでレポート出力する際に、リンク画像が一部印刷されないという現象が発生したことがありました。
いろいろ調べたけれど対処法が整理されたものがなかったので、こちらに備忘録として残しておこうと思います。

画像ファイルはリンクとして取り扱いしていますので、別の場所に画像が存在しリンクは切れていないという前提で、２～３レコード分なら表示されますが10レコード分となると表示されなくなり、なぜか画像が切れるときと切れない時がありました。

原因

まず原因としては、Accessの問題になります。

レポート印刷時に、印刷するページレイアウトをメモリに展開する途中で、レポート印刷用のメモリを使い切った時に発生するようです。「レポート印刷用のメモリサイズ」は、実装されている実メモリの容量や、仮想メモリの容量に関係なく「一定サイズ」になっているようです。

よって、１枚のページに複数の「大きいサイズの画像」が配置してあると、レポート印刷用のメモリを使い尽くし、メモリが足りなくなった部分の画像は「ページレイアウトへの展開が行なわれず、真っ白」になります。

この「レポート印刷用のメモリサイズ」は、固定サイズで実装してあるとのことなので、拡張する事は出来ないため、「すべてを印刷したい」なら「メモリを使い切らないように、画像の容量を小さくする」必要があります。

PCのメモリが高性能であってもこちらの問題は発生することがあります。
よって一番の対処法は、画像のサイズを小さくすることなのですが
既に大量の画像が保存されている場合、それらを１つ１つ小さくするのは
とてもではないが労力がかかるし、そもそも画像は小さくしたくないケースが多いです。

対処法について

対処法としては、すべてを印刷するならば画像容量を小さく変更するしかないようです。

そこで実現可能な方法としては

(対処法1)．画損保存時にサムネイル画像を作成してサムネイルも同時に管理する
(対処法2)．印刷時に選択された該当の画像を一括でサムネイル生成して印刷で使用する

となります。

対処法1(印刷時に一時的にサムネイル生成)について

対処法の1の方についての解説をしたいと思います。

印刷ボタンを押下時のイベントVBAにコードを追加します。

'***************************
' 印刷ボタンClick
'***************************
Private Sub cmd印刷_Click()
Dim objRsList As Recordset
Dim strSql As String
Dim iNo As Integer
Dim iSeqNo As Integer
Dim strOutputfileName As String
Dim filePath As String
Dim searchFileName As String
Dim currentFileName As String
Dim strSFilePath As String

On Error GoTo Error


    Application.Echo False
    
    Set objRsList = CurrentDb.OpenRecordset("SELECT * FROM wk_XX一覧 WHERE select_flag = true", dbOpenDynaset)
    If objRsList.RecordCount = 0 Then
        MsgBox "印刷するXXデータを選択してください。", vbExclamation + vbOKOnly, "入力確認"
        objRsList.Close: Set objRsList = Nothing
        Application.Echo True
        Exit Sub
    End If
    
    ' 必要な一時フォルダの準備
    Call killOutputFolder("")
    iNo = 1
    
    objRsList.MoveFirst
    Do Until objRsList.EOF
    
        filePath = objRsList.Fields("XXX_img_path_1").Value
        
        'ディレクトリ関数の準備
        searchFileName = filePath & "*"
        currentFileName = Dir(searchFileName, vbNormal)
        currentFileName = funSetEditCode(CStr(iNo), 2) & "_" & currentFileName
        
        If currentFileName <> "" Then
        
            '不要なファイルをはじくための処理
            If currentFileName Like "*.jpg" Or _
                currentFileName Like "*.jpeg" Or _
                currentFileName Like "*.png" Or _
                currentFileName Like "*.gif" Then
                
                strSFilePath = makeNewImage(filePath, currentFileName)
                
            End If
        End If

        ' レポートで使用する用の一時テーブルにサムネイルパス保管
        objRsList.Edit
        objRsList.Collect("s_XXX_img_path_1") = strSFilePath
        objRsList.Update
    
        objRsList.MoveNext
        iNo = iNo + 1
    Loop
    objRsList.Close: Set objRsList = Nothing
    
    DoCmd.OpenReport "R_XX一覧", acViewPreview

    Application.Echo True

Exit Sub
Error:
    Application.Echo True
    MsgBox "エラーが発生しました。エラー内容：" & ERR.Description & Chr$(10), vbCritical, C_MSG_TITLE
End Sub

下記は標準モジュールに関数を追加

Rem ----------------------------------------------------------------------------------
Rem     関数名   : makeNewImage
Rem     処理内容 : サムネイル画像を作成してファイルパスを返却
Rem     引  数　 : filePath = 実際のファイルパス
Rem                newName = サムネイル名
Rem     戻り値　 : 編集結果
Rem ----------------------------------------------------------------------------------
Public Function makeNewImage(filePath As String, newName As String) As String
Dim outputPath As String
Dim Img As WIA.ImageFile
Dim IP As WIA.ImageProcess

    makeNewImage = ""

    outputPath = gstrPrintPath & "\tmp"
    
    If outputPath = "" Then
        Exit Function
    End If
    
    If Dir(outputPath, vbDirectory) = "" Then
        MkDir outputPath
    End If
    
    Set Img = CreateObject("WIA.ImageFile")
    Set IP = CreateObject("WIA.ImageProcess")
    
    Img.LoadFile filePath
    
    ' 読み込んだ画像サイズ変更
    IP.Filters.Add IP.FilterInfos("Scale").FilterID
    IP.Filters(1).Properties("MaximumWidth") = 240
    IP.Filters(1).Properties("MaximumHeight") = 240
    
    Set Img = IP.Apply(Img)
    ' サムネイル保存
    Img.SaveFile outputPath & "\" & newName
    
    makeNewImage = outputPath & "\" & newName

End Function

まとめ

こちらのコードを使用するには、WIAライブラリを参照設定する必要があります。
Microsoft Windows Image Acquisition Library vX.X

この方法を使用する事により、重い画像も難なく出力することが可能になりました。
画質もそれ程違和感を感じないで良かったので採用となりました。
なお、その後にわかりましたが、そもそも重い画像は常に必要ではありませんでした。
詳細画面では綺麗な画像が必要なのでフル画像表示させる必要がありますが
一覧画面に表示する画像は、サムネイルで良いのでは・・？と思いました。
それをするということは、サムネイル画像も常に保持しておくという事になります。
データ移行しつつ、毎回画像の登録や更新する度にサムネイルも保持しておくのは・・ちょっとしんどいな・・と思います。
しかし、一覧画面が重い。ので、後日、(対処法2)の方を検討し実装することになりました。
一覧フォーム表示時、サムネイル画像を参照する様に変更したらかなり表示が早くなりました！！

早くなったので良しとします。

参考サイト
https://okwave.jp/qa/q9521392.html
http://not-to-forget-vba.seesaa.net/category/14341717-1.html