'=========================================================================================
'　004 名前をつけて保存ダイアログボックスを表示してファイル名を取得する         Windows版
'-----------------------------------------------------------------------------------------
'【ヒント】
' この画面のコードは、Windows版 Excel用です
' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分）
' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分）


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Option Explicit
Dim 初期表示名 As Variant                       '★★★
Dim ファイルフィルタ As Variant                 '★★★
Dim ガイド As Variant                           '★★★
Dim ファイル名 As String                        '★★★
Dim パス As Variant                             '★★★
Dim 位置 As Integer                             '★★★
Dim 拡張子区切 As Variant                       '★★★
Dim フォルダ区切 As Variant                     '★★★
Dim I As Integer                                '★★★
Dim タイトル As String
Dim スタイル As Long
Dim メッセージ As String
Dim 応答 As Variant


'=========================================================================================
Private Sub 名前をつけて保存ダイアログボックスを表示してファイル名を取得する() '★★★
    パス = Application.GetSaveAsFilename( _
        initialfilename:=初期表示名, _
        FileFilter:=ファイルフィルタ, _
        Title:=ガイド)                          'ダイアログボックスからパスを取り出す
    If パス <> False Then                       'キャンセルでなければ
        ファイル名が入力された場合の処理
    Else                                        'キャンセルの場合
        キャンセルボタンがクリックされた場合の処理
    End If
End Sub
'-----------------------------------------------------------------------------------------
Private Sub ファイル名が入力された場合の処理()
    パスからファイル名を取り出す
    メッセージ = "保存するときには、「" & ファイル名 & "」 のファイル名を使います"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Private Sub パスからファイル名を取り出す()          '★★★
    拡張子区切 = InStr(1, パス, ".", 1)             'パスの中のピリオドの位置を取得する
    For I = 1 To 拡張子区切                         '1文字目からピリオドの位置になるまで
        フォルダ区切 = InStr(I, パス, "\", 1)       'パスの中の円記号の位置を取得する
        If フォルダ区切 <> 0 And フォルダ区切 <> "" Then '円記号の位置がみつかったら
            位置 = フォルダ区切                     '円記号の位置を覚える
        End If
    Next                                            '繰り返す
    ファイル名 = Right(パス, Len(パス) - 位置)      'ファイル名を取得する
End Sub
'-----------------------------------------------------------------------------------------
Private Sub キャンセルボタンがクリックされた場合の処理()
    メッセージ = "「名前をつけて保存」ダイアログボックスの、" & Chr(13) & Chr(13) & _
                "［キャンセル］ボタンがクリックされました"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'=========================================================================================



'-----------------------------------------------------------------------------------------
Sub おためしマクロ()
    If Worksheets("Title").Range("L1").Value = "mac" Then 'Maintoshなら
        Application.Run "Mac_おためしマクロ"
        Exit Sub
    End If
    おためしメッセージを表示する
'
    ガイド = "保存するときに使うファイル名を選択してください （この段階では保存されません）" '★★★
    初期表示名 = "新しいブック名を入力することも可能です" '★★★
    ファイルフィルタ = "Excel ブック (*.xls), *.xls"    '★★★
    名前をつけて保存ダイアログボックスを表示してファイル名を取得する '★★★
'
    初期表示名 = "テキストファイル名を入力してください"     '★★★
    ファイルフィルタ = "テキスト ファイル (*.txt), *.txt"  '★★★
    名前をつけて保存ダイアログボックスを表示してファイル名を取得する '★★★
End Sub
'-----------------------------------------------------------------------------------------
Private Sub おためしメッセージを表示する()
    Worksheets("Title").Select
    Range("P17").Select                        'カーソルを定位置へ移動する
    タイトル = "500連発 第2弾 サンプルマクロ"
    スタイル = 64                               'vbInformation
    メッセージ = "「名前をつけて保存」ダイアログボックスが表示されたら、" & Chr(13) & Chr(13) & _
                "ファイル名を選択するか、入力してから" & Chr(13) & Chr(13) & _
                "［保存］ボタンをクリックしてください"
    If Worksheets("Title").Range("L1").Value = "7.0" Then 'Excel95なら
        メッセージ = メッセージ & Chr(13) & Chr(13) & _
                    " 【Excel95を使用中です、97以上のブックは選択不可】"
    End If
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Sub Auto_Close()
    Application.DisplayAlerts = False           '閉じる際に確認メッセージを出さない
    ActiveWorkbook.Close                        '現在開いているブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------



'=========================================================================================
'　004 名前をつけて保存ダイアログボックスを表示してファイル名を取得する         Maintosh版
'-----------------------------------------------------------------------------------------
'【ヒント】
' この画面のコードは、Maintosh版 Excel用です
' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分）
' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分）


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Option Explicit
Dim ファイルフィルタ As Variant                 '★★★
Dim ガイド As Variant                           '★★★
Dim ファイル名 As Variant                       '★★★
Dim タイトル As String
Dim スタイル As Long
Dim メッセージ As String
Dim 応答 As Variant


'=========================================================================================
Private Sub Mac_別名で保存ダイアログボックスを表示してファイル名を取得する() '★★★
    ファイル名 = Application.GetSaveAsFilename( _
        FileFilter:=ファイルフィルタ, _
        Title:=ガイド)                          'ダイアログボックスからパスを取り出す
    If ファイル名 <> False Then                 'キャンセルでなければ
        Mac_ファイル名が入力された場合の処理
    Else                                        'キャンセルの場合
        Mac_キャンセルボタンがクリックされた場合の処理
    End If
End Sub
'-----------------------------------------------------------------------------------------
Private Sub Mac_ファイル名が入力された場合の処理()
    メッセージ = "保存するときには、「" & ファイル名 & "」 を使います"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Private Sub Mac_キャンセルボタンがクリックされた場合の処理()
    メッセージ = "「別名で保存」ダイアログボックスの、" & Chr(13) & Chr(13) & _
                "［キャンセル］ボタンがクリックされました"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'=========================================================================================