Public Sub 月報_Print()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sheet_name As Variant
    Dim pPath As String
    Dim pFile As String
    Dim wsh As Object
    Dim p_Name As String
    Dim p_FilePath As String
    Dim strShCmnd As String
 
    Const parent_path = "C:\教えてgoo"      'ご説明されている「リンゴフォルダ」の親フォルダを指定
 
    Set wsh = CreateObject("Wscript.Shell")
    Set wb = ThisWorkbook
    MsgBox "シート選択ダイアログが表示されます。" & vbCrLf & "印刷する月報を選択してください "
    Do
        wb.Application.CommandBars("Workbook tabs").ShowPopup
        DoEvents
        sheet_name = Application.InputBox("このシートでいいですか？", , ActiveSheet.Name)
    Loop Until sheet_name <> False
    Worksheets(sheet_name).PrintOut
    pPath = parent_path & "\リンゴ\青森"
    p_FilePath = GetLatestPDF(pPath)
    p_Name = Application.ActivePrinter
    p_Name = Left(p_Name, InStr(p_Name, " on ") - 1)
    strShCmnd = "AcroRd32.exe /t " & p_FilePath & " " & p_Name
    wsh.Run (strShCmnd)
    Application.Wait Now + TimeValue("0:00:10")      '10秒待つ
    wsh.Exec ("taskkill.exe /F /IM AcroRd32.exe")
    Set wsh = Nothing
End Sub
Public Function GetLatestPDF(pPath As String) As String
    Dim chkTime As Date
    Dim maxTime As Date
    Dim chkName As String
    Dim maxName As String
 
    pPath = pPath & "\"
    chkName = Dir(pPath & "*.pdf")
    maxTime = FileDateTime(pPath & chkName)
    maxName = chkName
    Do While chkName <> ""
        chkTime = FileDateTime(pPath & chkName)
            If chkTime > maxTime Then
            maxTime = chkTime
            maxName = chkName
        End If
        chkName = Dir()
    Loop
    GetLatestPDF = pPath & maxName
End Function
 
 

UHVibGljIFN1YiDmnIjloLFfUHJpbnQoKQogICAgRGltIHdiIEFzIFdvcmtib29rCiAgICBEaW0gd3MgQXMgV29ya3NoZWV0CiAgICBEaW0gc2hlZXRfbmFtZSBBcyBWYXJpYW50CiAgICBEaW0gcFBhdGggQXMgU3RyaW5nCiAgICBEaW0gcEZpbGUgQXMgU3RyaW5nCiAgICBEaW0gd3NoIEFzIE9iamVjdAogICAgRGltIHBfTmFtZSBBcyBTdHJpbmcKICAgIERpbSBwX0ZpbGVQYXRoIEFzIFN0cmluZwogICAgRGltIHN0clNoQ21uZCBBcyBTdHJpbmcKICAgIAogICAgQ29uc3QgcGFyZW50X3BhdGggPSAiQzpc5pWZ44GI44GmZ29vIiAgICAgICfjgZToqqzmmI7jgZXjgozjgabjgYTjgovjgIzjg6rjg7PjgrTjg5Xjgqnjg6vjg4DjgI3jga7opqrjg5Xjgqnjg6vjg4DjgpLmjIflrpoKCiAgICBTZXQgd3NoID0gQ3JlYXRlT2JqZWN0KCJXc2NyaXB0LlNoZWxsIikKICAgIFNldCB3YiA9IFRoaXNXb3JrYm9vawogICAgTXNnQm94ICLjgrfjg7zjg4jpgbjmip7jg4DjgqTjgqLjg63jgrDjgYzooajnpLrjgZXjgozjgb7jgZnjgIIiICYgdmJDckxmICYgIuWNsOWIt+OBmeOCi+aciOWgseOCkumBuOaKnuOBl+OBpuOBj+OBoOOBleOBhCAiCiAgICBEbwogICAgICAgIHdiLkFwcGxpY2F0aW9uLkNvbW1hbmRCYXJzKCJXb3JrYm9vayB0YWJzIikuU2hvd1BvcHVwCiAgICAgICAgRG9FdmVudHMKICAgICAgICBzaGVldF9uYW1lID0gQXBwbGljYXRpb24uSW5wdXRCb3goIuOBk+OBruOCt+ODvOODiOOBp+OBhOOBhOOBp+OBmeOBi++8nyIsICwgQWN0aXZlU2hlZXQuTmFtZSkKICAgIExvb3AgVW50aWwgc2hlZXRfbmFtZSA8PiBGYWxzZQogICAgV29ya3NoZWV0cyhzaGVldF9uYW1lKS5QcmludE91dAogICAgcFBhdGggPSBwYXJlbnRfcGF0aCAmICJc44Oq44Oz44K0XOmdkuajriIKICAgIHBfRmlsZVBhdGggPSBHZXRMYXRlc3RQREYocFBhdGgpCiAgICBwX05hbWUgPSBBcHBsaWNhdGlvbi5BY3RpdmVQcmludGVyCiAgICBwX05hbWUgPSBMZWZ0KHBfTmFtZSwgSW5TdHIocF9OYW1lLCAiIG9uICIpIC0gMSkKICAgIHN0clNoQ21uZCA9ICJBY3JvUmQzMi5leGUgL3QgIiAmIHBfRmlsZVBhdGggJiAiICIgJiBwX05hbWUKICAgIHdzaC5SdW4gKHN0clNoQ21uZCkKICAgIEFwcGxpY2F0aW9uLldhaXQgTm93ICsgVGltZVZhbHVlKCIwOjAwOjEwIikgICAgICAnMTDnp5LlvoXjgaQKICAgIHdzaC5FeGVjICgidGFza2tpbGwuZXhlIC9GIC9JTSBBY3JvUmQzMi5leGUiKQogICAgU2V0IHdzaCA9IE5vdGhpbmcKRW5kIFN1YgpQdWJsaWMgRnVuY3Rpb24gR2V0TGF0ZXN0UERGKHBQYXRoIEFzIFN0cmluZykgQXMgU3RyaW5nCiAgICBEaW0gY2hrVGltZSBBcyBEYXRlCiAgICBEaW0gbWF4VGltZSBBcyBEYXRlCiAgICBEaW0gY2hrTmFtZSBBcyBTdHJpbmcKICAgIERpbSBtYXhOYW1lIEFzIFN0cmluZwogICAgCiAgICBwUGF0aCA9IHBQYXRoICYgIlwiCiAgICBjaGtOYW1lID0gRGlyKHBQYXRoICYgIioucGRmIikKICAgIG1heFRpbWUgPSBGaWxlRGF0ZVRpbWUocFBhdGggJiBjaGtOYW1lKQogICAgbWF4TmFtZSA9IGNoa05hbWUKICAgIERvIFdoaWxlIGNoa05hbWUgPD4gIiIKICAgICAgICBjaGtUaW1lID0gRmlsZURhdGVUaW1lKHBQYXRoICYgY2hrTmFtZSkKICAgICAgICAgICAgSWYgY2hrVGltZSA+IG1heFRpbWUgVGhlbgogICAgICAgICAgICBtYXhUaW1lID0gY2hrVGltZQogICAgICAgICAgICBtYXhOYW1lID0gY2hrTmFtZQogICAgICAgIEVuZCBJZgogICAgICAgIGNoa05hbWUgPSBEaXIoKQogICAgTG9vcAogICAgR2V0TGF0ZXN0UERGID0gcFBhdGggJiBtYXhOYW1lCkVuZCBGdW5jdGlvbgoK