テスト44

'ExcelからPDFを出力する時にA4にならない時の解決方法
'参考:『エクセルからPDF保存してFAX原稿を作成するとA4サイズにならない』
'https://nexlink-cs.nlk.jp/090_FAQ/detail_basic/00190.html

Sub Print_Select()

Dim myprint As Variant
'('ω')～♪
myprint = Application.ActivePrinter
Dim p As String
p = "C:\Users\User\Desktop\VBA練習\aa.oxps"

Call ActiveSheet.PrintOut(PrintToFile:=True, _
                                      PrToFileName:=p, _
                                      ActivePrinter:="Microsoft XPS Document Writer")
Kill p

'---------------------
'PDFで保存する処理
'---------------------

Application.ActivePrinter = myprint

End Sub


'Sub PDF_Open(strFileName As String)
'Dim objWSH As Object
'Dim Limit As Date
'Dim hwnd As Long
'Dim edt_hwnd As Long
'Dim btn_hwnd As Long
'Dim strPassword As String
'
''以下必要に応じて変更
''--------------------------------------
''制限時間(5秒)
'Limit = Now + TimeValue("00:00:05")
''PDFファイルのパスワード
'strPassword = "123"
''--------------------------------------
'
'Set objWSH = CreateObject("Wscript.Shell")
''PDFファイルオープン
'objWSH.Run """" & strFileName & """", 1
'
''パスワードダイアログのハンドル取得
'Do Until hwnd <> 0
'hwnd = FindWindow("#32770", "パスワード")
''処理待ち
'Sleep (50)
'
''もし制限時間を越えてもハンドルが取得できなかった場合はプロシージャ終了
'If Now >= Limit Then
'Exit Sub
'End If
'
'DoEvents
'Loop
'
'hwnd = FindWindowEx(hwnd, 0&, "GroupBox", vbNullString)
'
'If hwnd <> 0 Then
''パスワード入力欄のハンドル取得
'edt_hwnd = FindWindowEx(hwnd, 0&, "RICHEDIT50W", vbNullString)
''OKボタンのハンドル取得
'btn_hwnd = FindWindowEx(hwnd, 0&, "Button", "OK")
'
'If (edt_hwnd <> 0) And (btn_hwnd <> 0) Then
''パスワード送信
'Call SendMessage(edt_hwnd, WM_SETTEXT, 0&, strPassword)
''OKボタンをクリック処理
'Call SendMessage(btn_hwnd, WM_ACTIVATE, 1, 0&)
'Call SendMessage(btn_hwnd, BM_CLICK, 0, 0&)
'End If
'End If
'
'Set objWSH = Nothing
'End Sub

'Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
'Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'
'Private Const BM_CLICK As Long = &HF5
'Private Const WM_ACTIVATE As Long = &H6
'Private Const WM_SETTEXT As Long = &HC