Excelで日程表を作ってみよう:Step1 日程用の新しいブックを作成する

名前を付けて保存ダイアログを開くVBAの作成

Excel VBAで日程用の新しいブックを作成します。
ブック名は名前を付けて保存ダイアログボックスで入力します。


Homeに戻る > Excelでアプリケーションソフトを作ってみよう > 日程表を作ってみよう


作成したシート

コマンドボタンをおきます。
コマンドボタン

ボタンクリックイベント
Private Sub CommandButton1_Click()
    MakeNitteiBook
End Sub

Excel VBA 標準モジュールコード

Public Sub MakeNitteiBook()
    Dim makefile As String
    Dim bookname As String
    
    '作成するファイル名
    makefile = GetSaveFileName
    If makefile = "" Then
        Exit Sub
    End If
    
    '新規にブックを作成
    NewBookMake makefile
    
    'ブック名を取得
    bookname = GetFileName(makefile)
    bookname = GetFileNameOnly(bookname)
    Workbooks(bookname).Activate
End Sub

'作成するファイル名
Public Function GetSaveFileName() As String
    Dim sfile As String

    sfile = Application.GetSaveAsFilename(fileFilter:="保存するエクセルファイル (*.xls), *.xls")
    If sfile = "False" Then
        GetSaveFileName = ""
    Else
        GetSaveFileName = sfile
    End If
End Function

'新規にブックを作成
Public Sub NewBookMake(filename As String)
    Dim tFile As Workbook
    
    Set tFile = Workbooks.Add
    
    '上書きメッセージを表示させない
    Application.DisplayAlerts = False
    tFile.Saved = True
    tFile.SaveAs filename:=filename
    'tFile.Close
    Application.DisplayAlerts = True
End Sub

'フルパスからファイル名のみ取得
Function GetFileName(fullpath As String) As String
    Dim i As Integer
    Dim nlen As Integer
    Dim s As String

On Error GoTo Errsub
    nlen = Len(fullpath)
    For i = nlen To 0 Step -1
        s = Mid$(fullpath, i, 1)
        If s = "\" Then Exit For
    Next
    s = Right$(fullpath, nlen - i)
    GetFileName = s
    Exit Function
Errsub:
    GetFileName = ""
End Function

'ファイル名から拡張子を除く
Function GetFileNameOnly(sfina As String) As String
    Dim i As Integer
    Dim nlen As Integer
    Dim s1 As String
    Dim s2 As String

On Error GoTo Errsub
    s2 = ""
    For i = 1 To Len(sfina)
        s1 = Mid$(sfina, i, 1)
        If s1 <> "." Then
            s2 = s2 + s1
        Else
            Exit For
        End If
    Next
    GetFileNameOnly = s2
    Exit Function
Errsub:
    GetFileNameOnly = ""
End Function



Excel VBAの実行

ボタンをクリックすると、ファイル保存ダイアログが表示されます。
ファイル名を入力し「保存」ボタンをクリックすると、新規にブックが作成され前面に表示されます。
ファイル保存ダイアログ

新規に作成されたブック


Excelで日程表アプリ作成



Homeに戻る > Excelでアプリケーションソフト > 日程表を作ってみよう

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved