2023-03-07

EXCEL VBA AcrobatReaderやAdobeを使わずにPDFのページ数を取得する方法(ChatGPT編)

このブログで一番アクセスの多い記事について、

今流行のChatGPTさんに聞いてみました。

結果としては、以下の通りです。

/Count要素と/Type /Page要素以外の要素を使用してページ数を取得するためには、

PDFファイルのフォーマットを詳しく調べる必要があります。

PDFファイルのフォーマットに関する詳細は、Adobe Systemsが提供する

「PDFリファレンス」に記載されています。

PDFファイルにはカタログオブジェクト、ページツリー、アウトラインツリー、暗号化設定など、

ページに直接関係しないオブジェクトも含まれるため、ページ数を取得することは非常に困難です。

したがって、ページ数を取得するためには、PDFファイルのフォーマットについて詳しく調査し、

ページに関連するオブジェクトの特徴を把握し、適切な方法を選択する必要があります。

一般的には、/Count要素や/Type /Page要素を使用する方法が最も簡単で確実です。

PDFファイルのページを判別するための要素には、以下のようなものがあります。

/Count要素：この要素は、PDFファイル内のページ数を示します。

/Type /Page要素：この要素は、PDFファイル内の各ページを示します。

　　　　　　　　 PDFファイル内のページ数は、この要素の数に等しいです。

/Resources要素：この要素には、ページ内で使用されるフォント、イメージ、色空間などが含まれています。 /Contents要素：この要素には、ページのコンテンツが含まれています。

/MediaBox要素：この要素には、ページのメディアボックスのサイズが含まれています。

/CropBox要素：この要素には、ページのクロップボックスのサイズが含まれています。

/Rotate要素：この要素には、ページの回転角度が含まれています。

/Parent要素：この要素は、ページツリー内の親ページを示します。

/Annots要素：この要素には、ページに関連する注釈が含まれています。

以下は、AcrobatReaderやAdobeを使用せず、PDFファイルからページ数を取得するVBAコードの例です。

このコードは、まず指定されたPDFファイルをバイナリ形式で開き、

ファイルの内容を文字列として読み込みます。

その後、/Count要素が存在するかどうかを確認し、存在する場合はそれを使用してページ数を取得し、

存在しない場合は指定された要素を順に検索して最初に見つかった要素を使用してページ数を取得します。

最後に、ページ数をメッセージボックスで表示します。



Sub GetPageCount()

    Dim filePath As String
    filePath = "C:\example.pdf" ' PDFファイルのパスを指定する
    
    Dim pdfContent As String
    Open filePath For Binary Access Read As #1
    pdfContent = Space$(LOF(1))
    Get #1, , pdfContent
    Close #1
    
    Dim pageCount As Long
    pageCount = 0
    
    ' /Count要素が存在する場合は、それを使用してページ数を取得する
    If InStr(pdfContent, "/Count ") > 0 Then
        pageCount = CInt(Mid$(pdfContent, InStr(pdfContent, "/Count ") + 7, InStr(pdfContent, " ") - InStr(pdfContent, "/Count ") - 7))
    Else
        ' それ以外の要素でページ数を取得する
        Dim searchElements As Variant
        searchElements = Array("/Type /Page", "/Resources", "/Contents", "/MediaBox", "/CropBox", "/Rotate", "/Parent", "/Annots")
        For Each elem In searchElements
            If InStr(pdfContent, elem) > 0 Then
                pageCount = Len(pdfContent) - Len(Replace(pdfContent, elem, "")) / Len(elem)
                Exit For
            End If
        Next elem
    End If
    
    MsgBox "PDFファイルのページ数は " & pageCount & " ページです。"

End Sub

2022-07-01

プライバシーポリシー

・個人情報の取得

当ブログではお問い合わせフォームや記事へのコメントの際にメールアドレス等の個人情報を
入力いただくことがあり、個人情報と合わせて送信元のIPアドレスを取得しています。
入力いただいた個人情報は、お問い合わせに対する回答やご連絡を要する場合、また、嫌がらせなど
お問い合わせフォームの悪用があった場合に利用します。これらの目的以外での利用はいたしません。

・Cookieの利用

当ブログでは、閲覧者の興味に応じた広告を表示したりブログの閲覧状況を測定するため、
第三者企業によるクッキー（Cookie）、画像ファイル（ウェブビーコン）などを利用しています。
これらクッキーは第三者企業が直接ご利用の端末情報を取得し、各企業の定めるプライバシーポリシーに
従って管理されます。

クッキーから得られる情報は匿名であり、閲覧者個人を特定することはできません。
また、目的外の用途で利用されることもありません。

閲覧者は第三者企業のサイトにアクセスし、個別にクッキーの無効化など設定を行うことが可能です。
また、クッキーの送受信に関する設定で「クッキーの送受信を拒否する」といった選択を行い、
クッキーの送受信を拒否したり、https://optout.aboutads.info にて 第三者企業のCookieを無効に
することができます。

当サイトで利用している企業、サービスは下記の通りです。詳細は各企業サイトにてご確認ください。

 Google AdSense （https://policies.google.com/technologies/ads?gl=jp）

・コメントについて

はてなブログでは、ゲストがブログへのコメントを残す際にブログ作者にIP アドレスが公開されます。
これは、嫌がらせやスパム行為への対応といった運営管理のために設定されている機能であり、
目的外に利用したりみだりに公開することはいたしません。

2022-04-27

■

追加で二人倒れて

ついにそのグループは消滅した

2022-03-02

生存確認

隣のプロジェクトが炎上しているのでヘルプに入っている。

二人精神的に倒れて、もう一人倒れそう笑

2021-08-29

EXCEL VBA Wordファイルの指定ページを章番号を含めエクセルに貼り付けたい

ワードの指定ページを章番号等をまるまるエクセル貼り付けたいと思って調べたら大変だったので結果をまとめて記載する。

まあ、そもそもワードのページをエクセルに貼り付けるとかやってることはクソだが、仕方ない。

検索をするとエクセルの表などをワードに取り込む方法ばかりヒットする。

検索意図と真逆の結果がヒットするのどうにかならんのか。

◆最終的な対応方法

章番号を文字列に変換してからページをコピーし貼り付ける方法でうまくいった。

ただし、章番号を文字列に変換した際、章番号の開始位置がずれてしまう。

この謎仕様は放置した。

■VBAでマクロを作成中に発生した問題点

◆問題点①：ワードのページをコピーしてエクセルに貼り付けると、章番号が保持されない。

　⇒章番号を文字列に変換してからページをコピーして解決。

　Selection.Range.ListFormat.ConvertNumbersToText NumberType:=wdNumberParagraph

　Selection.Range.ListFormat.ConvertNumbersToText NumberType:=wdNumberAllNumber

　Selection.Range.ListFormat.ConvertNumbersToText NumberType:=wdNumberListNumber

◆問題点②：ワードのページをコピーしてエクセルに貼り付けると、表などの背景色が青や黒に変わってしまう。

　⇒問題となった部分の背景色を白で塗りつぶして暫定対応

　Selection.Shading.BackgroundPatternColor = -603914241

以下ソースワードを章番号を含めて1ページ目から最終ページまでをコピーしてエクセルに貼り付けるマクロ

Sub WordCopy()
    Const wdGoToPage=1
    Const wdGoToFirst=1
    Const wdNumberOfPagesInDocument=4
    Const wdPrintView=3
    Const wdNumberParagraph = 1
    Const wdNumberListNum = 2
    Const wdNumberAllNumbers = 3
    Const wdStory = 6
    
    Dim Full_FilePath as String
    Full_FilePath = "***.docx"
    
    Dim objWord As Object
    Dim wdDoc As Object
    
    Set objWord = CreateObject("Word.Application")
    'ワードを起動
    objWord.Visible = True
    
    Set wdDoc = objWord.Documents.Open(Full_FilePath)
    
    Dim Pages As Long
    Dim num As Long
    Dim Rows As Long 'エクセルのページの貼り付け行位置
    Rows = 1
    '表示形式を印刷プレビュー形式に設定
    objWord.ActiveWindow.View.Type = wdPrintView
    
    '全体を選択
    objWord.Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst,Count:=1
    objWord.Selection.WholeStory
    '編集を禁止
    objWord.Selection.Fields.Locked = True
    '段落番号、リスト番号、数値を文字列に変換
    objWord.Selection.Range.ListFormat.ConvertNumbersToText NumberType:=wdNumberParagraph
    objWord.Selection.Range.ListFormat.ConvertNumbersToText NumberType:=wdNumberListNum
    objWord.Selection.Range.ListFormat.ConvertNumbersToText NumberType:=wdNumberAllNumbers
    '総ページ数を取得
    Pages = wdDoc.Content.Information(wdNumberOfPagesInDocument)
    
    Dim myEnd As Long
    For num=1 to Pages
        if num <= Pages Then
            If num = Pages Then
                '最終ページはページの最後までを選択
                objWord.Selection.EndKey Unit:=wdStory
                myEnd = objWord.Selection.End
                objWord.Selection.GoTo What:=wdGoToPage,Which:=wdGoToFirst,Count:=num
                objWord.Selection.End = myEnd
                ’この処理は完全に任意
                '表の背景が青や黒になってしまう場合、背景色を白で塗りつぶして対応したが、最善策ではない。
                objWord.Selection.Shading.BackGroundPatternColor=-603914241
            Else
                objWord.Selection.GoTo What:=wdGoToPage,Count:=num+1
                myEnd = objWord.Selection.End

                objWord.Selection.GoTo What:=wdGoToPage,Which:=wdGoToFirst,Count:=num+1
                myEnd = objWord.Selection.Start-1
                objWord.Selection.GoTo What:=wdGoToPage,Which:=wdGoToFirst,Count:=num
                myEnd = objWord.Selection.End                
                
            End If
            
            objWord.Selection.Copy
            Range(Cells(Rows,1),Cells(Rows,1)).Select
            ActiveSheet.PasteSpecial Format:="Microsoft Word文書オブジェクト",Link=False,DisplayAsIcon:=False
            'ActiveSheet.PasteSpecial Format:="図（拡張メタファイル）",Link=False,DisplayAsIcon:=False
            '1ページだいたい65行
            Rows = Rows+65
        End If
    Next
    
    Application.DisplayAlerts = False
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    
    objWord.Visible = False
    objWord.Quit SaveCHanges:=False
    Set wdDoc = Nothing
    Set objWord = Nothing
End Sub

2021-08-06

夏季休暇なし！

2021-07-25

Unity クイズゲーム作成#5

Unityでandroid スマホ向けクイズゲーム作成状況5週目。

■今週やったこと

クリアシーンを作成して問題数がゼロ、かつ、敵のHPがゼロになった場合に遷移するように条件を設定。

問題数がゼロのときに敵HPがゼロでない場合、同じ問題が出てしまう状態。

どういった仕様にするのがいいだろうか考え中。

■残課題(先週から変わらず)

・最後の問題以降、同じ問題が出る。

　(敵HPが残っているときに問題がなくなった場合どうするか未検討)

・ユーザー登録、ログイン　未実装(いらんかも)

・アイテム使用時の判定処理未実装

・虫眼鏡(問題のヒントとか敵ステータスを調べるとか)未実装

・履歴を残す機能を作りたい。

・問題登録機能を作りたい。

・BGM未実装

・効果音未実装

・ランキング機能を作りたい。