【VBA】ブックを開く/ブックを保存する

0

    <機能>

    (1)新規ブックを作成し保存します

     シート数を指定して新規ブックを作成します

     シート名を変更します

    (2)ブックを開きます

    (3)ブックを編集後、保存します

     上書き保存

     名前を付けて保存(サンプル掲載)

     名前を付けてパスワード付きで保存(サンプル掲載)

     Webページとして保存(サンプル掲載)

     ダイアログボックス(Dialogs)で保存(サンプル掲載)

     

    <使い方>

    適当なところにソースを張り付けてください

    ブックの新規作成と保存()を呼び出すとブックの操作を行います

     新規ブック作成

     →新規ブックを保存

     →ブックを開く

     →ブックを編集

     →上書き保存(他サンプルあり)

     

    <イメージ>

    ブックを新規作成する際のシート数は オプション > 基本設定 > ブックのシート数(S) に設定されていますが一時的に変更します

    VBA,ブックを開く,ブックを保存する,上書き保存,パスワード,ダイアログ,シート名変更,Excel Workbook,SaveAs,FileFormat

    サンプルデータを設定してブックを保存します

    VBA,ブックを開く,ブックを保存する,上書き保存,パスワード,ダイアログ,シート名変更,Excel Workbook,SaveAs,FileFormat

     

    '********************************************

    'ブックの読み込みと保存

    ' (1)テスト用のブックを生成(ブック名年月日時分秒)

    ' (2)テスト用のブックを読み込み後、別名で保存

    '********************************************

    Sub ブックの新規作成と保存()

        Dim strName As String

        

        '//ブック名を生成

        strName = ThisWorkbook.Path & "¥SAMPLE_" & Replace(Replace(Replace(Now(), "/", ""), " ", ""), ":", "") & ".xlsx"

        '//ブックを作成

        新規ブックを作成する strName

        

        '//ブックを編集(先頭シートを編集)して上書き保存

        ブックを編集して保存 strName

    End Sub

     

    '********************************************

    '新規ブックを作成する

    ' (1)シート数を指定

    ' (2)シート名を変更

    '********************************************

    Sub 新規ブックを作成する(ByVal strBook As String)

        Dim wkSheetcnt As Integer

        Dim wkstr As String

        Dim i As Integer

        

        '//オプション > 基本設定 > ブックのシート数(S) の設定値を保持

        wkSheetcnt = Application.SheetsInNewWorkbook

        

        '//一時的に オプション > 基本設定 > ブックのシート数(S) の設定値を変更

        Application.SheetsInNewWorkbook = 10

        '//ブックを新規作成(シート数は10)

        Workbooks.Add

        

        '//オプション > 基本設定 > ブックのシート数(S) の設定値をもとに戻す

        Application.SheetsInNewWorkbook = wkSheetcnt

        

        '//シート名変更

        '//"Sheet" + シート番号(2桁固定)

        For i = 1 To ActiveWorkbook.Sheets.Count

            wkstr = Format(i, "00")

            ActiveWorkbook.Sheets(i).Name = "Sheet" & wkstr

        Next

        

        '//ブックを保存して閉じる

        '//FileFormatにExcelブック(*.xlsx)形式を指定

        '//XlFileFormat列挙体の設定値についてはMSDN参照

        ActiveWorkbook.SaveAs Filename:=strBook, FileFormat:=xlOpenXMLWorkbook

        ActiveWorkbook.Close

    End Sub

     

    '********************************************

    'ブックを開いて編集後に保存

    ' (1)先頭シートを編集

    ' (2)ブックを保存

    '********************************************

    Sub ブックを編集して保存(ByVal strBook As String)

        Dim ipos As Integer

        Dim wkstr As String

        '//ブックを開く

        Workbooks.Open strBook

        '//先頭シートを編集のためアクティブにする

        ipos = InStrRev(strBook, "¥")

        If ipos > 0 Then

            strfil = Right(strBook, Len(strBook) - ipos)

        Else

            MsgBox "ファイルパスが不正なため処理を中止します" & vbCrLf & strBook, vbCritical

            Exit Sub

        End If

        Workbooks(strfil).Activate

        Sheets(1).Activate

        

        '//先頭シートに書式を設定

        Columns("A").ColumnWidth = 7

        Columns("B:D").ColumnWidth = 35

        Columns("A:D").Font.Name = "MS ゴシック"

        Columns("A:D").Font.Size = 12

        With Range("A1:D3").Borders

            .Weight = xlThin

        End With

        With Range("A1:D1")

            .Interior.ColorIndex = 45

            .Font.ColorIndex = 35

        End With

        '//先頭シートにサンプルデータをセット

        Cells(1, 1) = "コード"

        Cells(1, 2) = "支店名"

        Cells(1, 3) = "住所"

        Cells(1, 4) = "電話番号"

        

        Cells(2, 1) = "A001"

        Cells(2, 2) = "新宿駅前支店"

        Cells(2, 3) = "東京都新宿区新宿1−2−3"

        Cells(2, 4) = "03-1234-5678"

        

        Cells(3, 1) = "A002"

        Cells(3, 2) = "横浜支店"

        Cells(3, 3) = "神奈川県横浜市中区桜木町 1−2−3"

        Cells(3, 4) = "045-123-4567"

        

        '//確認メッセージを表示しない

        Application.DisplayAlerts = False

        

        '//ブックを上書き保存して閉じる

        Workbooks(strfil).Save

        

        '//名前を付けて保存する場合

        'Workbooks(strfil).SaveAs Filename:="SampleBook.xlsx"

        'Workbooks("SampleBook.xlsx").close

        

        '//名前を付けてパスワード付きで保存する場合

        'Workbooks(strfil).SaveAs Filename:="SampleBook.xlsx", Password:="abcde"

        'Workbooks("SampleBook.xlsx").Close

        

        '//Webページとして保存する場合

        'Workbooks(strfil).SaveAs Filename:="SampleBook.html", FileFormat:=xlHtml

        'Workbooks("SampleBook.html").Close

        

        '//ダイアログボックスで保存する場合

        'Dim bSave As Boolean

        'bSave = Application.Dialogs(xlDialogSaveAs).Show

        'If bSave Then

        '    Debug.Print "保存されました"

        'End If

        

        '//元のブックがまだ開いていれば閉じる

        Dim wkbk As Workbook

        For Each wkbk In Workbooks

            If wkbk.Name = strfil Then

                Workbooks(strfil).Close

                GoTo alerts_true

            End If

        Next wkbk

        

    alerts_true:

        Application.DisplayAlerts = True

    End Sub

     

    よろしければポチッと押してください


    プログラマー ブログランキングへ

     



    calendar

    S M T W T F S
         12
    3456789
    10111213141516
    17181920212223
    24252627282930
    31      
    << December 2017 >>

    profile

    others

    mobile

    qrcode