Office365-Excel（64bit）のマクロでプリンタの印刷設定取得（DocumentProperties）で落ちる

Question

【環境】Windows10(64bit)、Office365-Excel（64bit）

（参考）Microsoft® Excel® for Microsoft 365 MSO (バージョン 2406 ビルド 16.0.17726.20078) 64 ビット

Excelマクロにて、プリンタの印刷設定を取得したいのですが、DocumentProperties(～)の呼び出しでExcelが異常終了します。

下記マクロの「★ここでExcelが落ちる」と記載している箇所になります。

デバッグ結果を参考に記載します。

(1)「result = OpenPrinter(PrinterName, hPrinter, ByVal 0&)」

　⇒正常に動作：result=1

(2)「result = DocumentProperties(0, hPrinter, PrinterName, ByVal 0&, ByVal 0&, 0)」

　⇒正常に動作：result=4840

(3)「ReDim yDevModeData(result + 100) As Byte」

　⇒再定義後【Watch : + : yDevModeData : : Byte(0 to 4940) 】

(4)「result = DocumentProperties(0, hPrinter, PrinterName, VarPtr(yDevModeData(0)), ByVal 0&, DM_OUT_BUFFER)」

　⇒Excelが落ちる。（エラーメッセージ等なく落ちて、Excelが再起動します。）

　　▼ウォッチ結果

　　Watch : : hPrinter : 1772639467136^ : LongLong : Printer_Duplex.GetPrinterDuplex

　　Watch : : PrinterName : "プリンタ名（記載は省略します）" : String : Printer_Duplex.GetPrinterDuplex

　　Watch : : yDevModeData(0) : 0 : Byte : Printer_Duplex.GetPrinterDuplex

　　Watch : : VarPtr(yDevModeData(0)) : 1774936438160^ : LongLong : Printer_Duplex.GetPrinterDuplex

※32ビットExcel⇒64ビットExcelに移行が必要になり、修正を行っている。

※VB.NetからExcelのマクロを起動して、プリンター設定情報を取得しようとしている。

あまり詳しくはないため、申し訳ございませんが、問題のロジックがあればご教示頂けますと幸いです。

▼マクロ-------------------------------------------------------------------

Option Explicit

Public Const DM_OUT_BUFFER As Long = 2

Private Declare PtrSafe Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesW" (ByVal hWnd As LongPtr, ByVal hPrinter As LongPtr, ByVal pDeviceName As String, pDevModeOutput As LongPtr, pDevModeInput As LongPtr, ByVal fMode As Long) As Long

Private Declare PtrSafe Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As LongPtr, pDefault As Any) As Long

Private Declare PtrSafe Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As LongPtr) As Long

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'Private Declare PtrSafe Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As LongPtr, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long

'Private Declare PtrSafe Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As LongPtr, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As Long

'Public Function GetPrinterDuplex(ByVal PrinterName As String) As Long

Public Function GetPrinterDuplex() As Long

Dim hPrinter As LongPtr 

Dim pDevMode As LongPtr 

Dim y As Long 

Dim result As Long 

Dim PrinterName As String 

PrinterName = "ここにプリンタ名" 'デバッグ用 

result = OpenPrinter(PrinterName, hPrinter, ByVal 0&)    '←正常に動作する

If result = 0 Then 

    MsgBox "プリンタを開くことができませんでした。エラーコード: " & Err.LastDllError 

    GoTo Cleanup 

End If 

result = DocumentProperties(0, hPrinter, PrinterName, ByVal 0&, ByVal 0&, 0)    '←正常に動作する（resultには「4840」が返る」

If result < 0 Then 

    MsgBox "DEVMODE構造のサイズを得ることができません。エラーコード: " & Err.LastDllError 

    GoTo Cleanup 

End If 

ReDim yDevModeData(result + 100) As Byte 

**result = DocumentProperties(0, hPrinter, PrinterName, VarPtr(yDevModeData(0)), ByVal 0&, DM\_OUT\_BUFFER)   '★ここでExcelが落ちる**

If result < 0 Then 

    MsgBox "DEVMODE構造のサイズを得ることができません。エラーコード: " & Err.LastDllError 

    GoTo Cleanup 

End If 

pDevMode = VarPtr(yDevModeData(0)) 

pDevMode = pDevMode + 404 

CopyMemory y, ByVal pDevMode, 2 

GetPrinterDuplex = y 

Cleanup:

If hPrinter <> 0 Then Call ClosePrinter(hPrinter) 

End Function

▲マクロ（ここまで）-----------------------------------------------------------------

Answer 1

説明いただきありがとうございます。

Stack Overflowで質問するべきで、英語での説明が必要なのですね。

ありがとうございました。

Answer 2

VBA(マクロ)の公式サポート場所は、海外コミュニティとなっています。

有識者が集まっている所の方が、適切なアドバイスを受けやすいでしょう。

・Stack Overflow(VBA)

　　[VBA プログラミングに関する質問]

　　Stack Overflow には、説明的なタイトル、完全で簡潔な問題ステートメント、問題を再現する
　　ための十分な詳細の要求などのガイドラインがあることに注意してください。
　　機能要求または過度に広範な質問は、トピック外と見なされます。
　　新しいユーザーの場合は、Stack Overflow ヘルプ センター にアクセスして詳細を確認して下さい。

※ 閲覧者・回答者が多い公式サポートサイトをお勧めします。

　 英語で質問を送信してください。