Excel VBA ショートカット関数（シート印刷）

Excel VBA の ショートカット関数を作る。

VBA に ショートカット関数を使用すると、VBA コマンドを 短縮して記述できます。

ショートカット関数

シート印刷
シート存在判定
ファイル存在判定

c_シート印刷

■説明
 指定したシートを印刷またはプレビューします。

■記述例
i = c_シート印刷("見積書","伝票印刷.xlsm","する")

■構文
 c_シート印刷("<シート名>","<ブック名>","<プレビュー処理>")

■パラメータ
・<シート名>
 印刷するシート名を記述してください。

・<ブック名>
［省略可］省略した場合は、実行中のブック名になります。
印刷するブックファイル名をフルパスで記述してください。（拡張子も記述してください）

・<プレビュー処理>
する｜しない 
［省略可］規定値は、する

■戻り値
成功は 1 失敗は 0 を返します。

■VBA

PrintSheet.vba

Function c_シート印刷(qSheet As String, qBook As String, qIsPreview As String) As Integer
  '
  '【構文】  c_シート印刷("<シート名>","<ブック名>,"<プレビュー処理>")
  '【戻り値】成功:1 失敗:0
  '
  Dim wFL     As Integer
  Dim wBook   As String
  Dim wIsPreview As String
  
  c_シート印刷 = 0
  
  'Book名省略
  If qBook = "" Then
    wBook = ThisWorkbook.Name
  Else
    wBook = qBook
  End If
  
  'Bookを判定
  wFL = c_ファイル存在判定(wBook, True)
  If wFL = 0 Then Exit Function
  
  'Sheetを判定
  wFL = c_シート存在判定(qSheet, qBook, False, True)
  If wFL = 0 Then Exit Function
  
  '印刷処理
  With Workbooks(wBook)
  
    '自動計算チェック
    'Application.Calculation = xlCalculationAutomatic
    .Worksheets(qSheet).Activate
    
    'プレビュー処理を省略
    If qIsPreview = "" Then
      wIsPreview = "する"
    Else
      wIsPreview = qIsPreview
    End If
    
    Select Case wIsPreview
      Case "する"
        'プレビュー
        .Worksheets(qSheet).PrintOut preview:=True
        
      Case Else
       '印刷
       .Worksheets(qSheet).PrintOut
    End Select
  End With
  
  '初期状態 Close
  If wFL = 2 Then
    Workbooks(wBook).Close savechanges:=False
  End If
  
  c_シート印刷 = 1
End Function

IsSheet.vba

Function c_シート存在判定(qSheet As String, qBook As String, qBookClose As Boolean, qIsErrorMsg As Boolean) As Integer
  '
  '【構文】  c_シート存在判定("<シート名>","<ブック名>",<終了状態>,<エラー表示指定>)
  '【戻り値】成功(初期Open):1 成功(初期Close):2 失敗:0
  '
  Dim wFL     As Integer
  Dim wFLMsg  As Integer
  Dim wMSG    As String
  Dim wBook   As String
  Dim wPath   As String
  Dim wFile   As String
  Dim wExt    As String
  Dim wVar    As Variant

  c_シート存在判定 = 0

  'シート名を省略
  If qSheet = "" Then
    wMSG = "シート名を指定してください。"
    MsgBox wMSG, vbOKOnly + vbExclamation, "確認"
    Exit Function
  End If

  'Book名を省略
  If qBook = "" Then
    wBook = ThisWorkbook.Name
  Else
    wBook = qBook
  End If
  
  'パス指定がない
  If InStr(wBook, "\") = 0 Then
    wPath = ThisWorkbook.Path
    wFile = wPath & "\" & wBook
  Else
    wFile = wBook
  End If
  
  wFL = c_ファイル存在判定(wFile, True)
  If wFL = 0 Then Exit Function
  
  'ExcelBookを判定(xlsx/xlsm)
  
  'Book Open を判定
  wBook = fnPickFile(wFile)
  
  wFL = c_ブックオープン判定(wBook, False)
  If wFL = 0 Then
    wMSG = "ブック（" & wBook & "）が、開いていません。" & vbCrLf & _
           "オープンしますか？"
    wFLMsg = MsgBox(wMSG, vbYesNo + vbQuestion, "確認")
    If wFLMsg = vbYes Then
      'Workbooks.Open FileName:=wFile
      Set wVar = Workbooks.Open(wFile)
      
      If TypeName(wVar) <> "Workbook" Then
        wMSG = "オープンできません。"
        MsgBox wMSG, vbOKOnly + vbExclamation, "確認"
        Exit Function
      End If
    Else
      Exit Function
    End If
  End If
  
  If fpIsSheet(wBook, qSheet) = True Then
    If wFL = 0 Then
      '初期Close
      c_シート存在判定 = 2
    Else
      '初期Open
      c_シート存在判定 = 1
    End If
  End If
  
  'Bookを閉じる
  If wFL = 1 And qBookClose = True Then
    Workbooks(wBook).Close savechanges:=False
  End If
End Function

IsFile.vba

Function c_ファイル存在判定(qFile As String, qIsErrorMsg As Boolean) As Integer
  '
  '【構文】  c_ファイル存在判定("<ファイル名>",<エラー表示指定>)
  '【戻り値】成功:1 失敗:0
  '
  Dim wMSG    As String
  Dim wPath   As String
  Dim wFile   As String
  Dim wFolder As String
  
  c_ファイル存在判定 = False
  
  'ファイル名を省略
  If qFile = "" Then
    wMSG = "ファイルを指定してください。"
    MsgBox wMSG, vbOKOnly + vbExclamation, "確認"
    Exit Function
  End If
  
  '拡張子がない
  If InStr(qFile, ".") = 0 Then
    wMSG = "ファイル名に拡張子を記述してください。"
    MsgBox wMSG, vbOKOnly + vbExclamation, "確認"
    Exit Function
  End If
  
  'パス指定がない
  If InStr(qFile, "\") = 0 Then
    wPath = ThisWorkbook.Path
    wFile = wPath & "\" & qFile
  Else
    wFile = qFile
  End If
  
  gLng0 = PathFileExists(wFile)
  'ファイルがない
  If gLng0 <> 1 Then
    If qIsErrorMsg = True Then
      wMSG = "フォルダ（" & fnPickFolder(wFile) & "）に" & vbCrLf & _
             "ファイル（" & fnPickFile(wFile) & "）が、見つかりません。"
      MsgBox wMSG, vbOKOnly + vbExclamation, "確認"
    End If
    Exit Function
  End If
  
  c_ファイル存在判定 = True
End Function

ショートカット関数 マニュアル