すぐに役立つエクセルVBAマクロ集 - すぐマク
すぐに役立つ Excel VBA マクロ集 Excel VBA Macro
Macro
Google
 
Home |  What's New! |  Gallery |  Introduction |  Service |  Profile

500連発・組み方講座フォロー

Big Color Pallet

[広告]
 
Excel VBA Macro
Excel DownLoad
© 1997 - 2007
Yoshioh Nagai.
All RightsReserved.
HappyTech & Co., Ltd.
www.happy500z.com
Sample Macro  ブックシート [基本型] Previous Next
ブックシート
[基本型]
1) ブックを開く
2) ファイルの情報を取得
3) ブックを保存する、閉じる
4) 保存してない変更があるか調べる
5) Webページとして保存する
6) 新しいブックを作成する
7) ブック・シートをアクティブに
8) ブック・シート名を取得・変更
9) ブックのシート数を取得
10) ブックのプロパティの設定・取得
11) ファイル形式を取得する
12) ブックを保護・非保護
13) シートを保護・非保護
14) ブックの複写・削除・移動・変更
15) ブックのアクセス権変更
16) シート切替時の自動処理
17) シートを隠す
18) シートを削除する
19) シートを追加する
20) シート見出しをスクロールする
21) シート見出しの色を設定する
22) シートの背景のグラフィックスを設定する


1) ブックを開く もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ブックを開く()
    Workbooks.Open FILENAME:=("BBB.xls")        '※1
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックを読み取り専用で開く()
    Workbooks.Open FILENAME:=("BBB.xls"), ReadOnly:=True '※1
End Sub
'=========================================================================================
<コメント>
※1 BBBにはブック名を記入







 
2) ファイルの情報を取得する もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub 開きたいファイルの場所とファイル名を取得する()
    タイトル = "開きたいファイルの場所と、ファイル名を選択してください" '※1
    ボタン = "決 定"                                                '※2
入力:
    パス = Application.GetOpenFilename(Title:=タイトル, buttontext:=ボタン) 'ダイアログ表示
    If パス <> False Then
        MsgBox パス, vbInformation, "開きたいファイルの場所と、ファイル名"
    Else
        MsgBox "不正な選択です、やり直してください", vbExclamation, タイトル
        GoTo 入力
    End If
End Sub
'-----------------------------------------------------------------------------------------
Sub ファイルを保存する場所とファイル名を取得する()
    タイトル = "ファイルを保存する場所とファイル名を、選択または入力してください" '※1
    ボタン = "決 定"                                                          '※3
入力:
    パス = Application.GetSaveAsFilename(Title:=タイトル, buttontext:=ボタン) 'ダイアログ
    If パス <> False Then
        MsgBox パス, vbInformation, "ファイルを保存する場所と、ファイル名"
    Else
        MsgBox "不正な選択です、やり直してください", vbExclamation, タイトル
        GoTo 入力
    End If
End Sub
'-----------------------------------------------------------------------------------------
Sub ファイルの種類を指定してファイルを開くダイアログを表示する() '※4
    ファイル名 = Application.GetOpenFilename(FileFilter:="CSV_File (*.csv), *.csv")
End Sub
'=========================================================================================
<コメント>
※1 ダイアログボックスのタイトル、Windows版だけに有効
※2 ダイアログボックスの「開く」ボタンの文字、Macintosh版だけに有効
※3 ダイアログボックスの「保存」ボタンの文字、Macintosh版だけに有効
※4 ダイアログボックスで選択されたファイルは実際には開かれない
サンプルブックのダウンロードは ここをクリック (YNxv202_information.xls 72KB)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。


3) ブックを保存する、閉じる もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub アクティブブックを名前を付けて保存する()
    ブック名 = "BBB.xls"                        '※1
    ActiveWorkbook.SaveAs ブック名
End Sub
'-----------------------------------------------------------------------------------------
Sub アクティブブックのコピーを保存する()
    ActiveWorkbook.SaveCopyAs Filename:="BBB_Copy.xls" '※1
End Sub
'-----------------------------------------------------------------------------------------
Sub アクティブブックを上書き保存して閉じる()
    ActiveWorkbook.Save                         '上書き保存
    Application.DisplayAlerts = False           'メッセージを出さない
        ActiveWorkbook.Close                    '閉じる
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックのファイル形式を指定して保存する()
    ActiveWorkbook.SaveAs FileFormat:=xlNormal '※2
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックの内容の変更を保存しないで閉じる()
    Workbooks("BBB.xls").Close SaveChanges:=False '※1
End Sub
'-----------------------------------------------------------------------------------------
Sub 開かれているすべてのブックを閉じる()
    Workbooks.Close
End Sub
'=========================================================================================
<コメント>
※1 BBB、または、BBB_Copyにはブック名を記入
※2 FileFormatプロパティの定数と値は こちら


4) 保存してない変更があるか調べる もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub 保存してない変更があるか調べる()
    Worksheets("SSS").Activate                  'ワークシートをアクティブにする ※1
    If ActiveWorkbook.Saved = False Then        'False(変更を未保存)なら
        メッセージ = "保存してない変更があります"
        MsgBox メッセージ, vbExclamation, "サンプルマクロ"
    Else                                        'そうでなければ
        メッセージ = "保存してない変更は、ありません" & Chr(13) & Chr(13) & _
                "「OK」ボタンを押してから、セルに何か入力し、" & Chr(13) & Chr(13) & _
                "その後で、お試しボタンを押してみてください"
        MsgBox メッセージ, vbInformation, "サンプルマクロ"
    End If
End Sub
'=========================================================================================
<コメント>
※1 SSSにはシート名を記入
サンプルブックのダウンロードは ここをクリック (YNxv202_Saved.xls 35KB)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。


5) Webページとして保存する もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub アクティブブックをWebページとして保存する()
    ドライブ = "C"                                  '※1
    フォルダ名 = "My Documents"                     '※2
    ファイル名 = "ExcelBookをWebページに"           '※3
    パス = ドライブ & ":\" & フォルダ名 & "\" & ファイル名 & ".html" '※4
    ActiveWorkbook.SaveAs Filename:=パス, FileFormat:=xlHtml '※5
End Sub
'=========================================================================================
<コメント>
※1 保存するドライブ番号を指定
※2 保存するフォルダ名を指定
※3 保存するファイル名を指定
※4 拡張子の '.html' は 'htm' でもよい
※5 FileFormatプロパティの値は、xlHtml とする
サンプルブックのダウンロードは ここをクリック (YNxv202_Web.xls 29KB)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。


6) 新しいブックを作成する もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub 新しいブックを作成する()
    Workbooks.Add
End Sub
'=========================================================================================


7) ブック・シートをアクティブに もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ブックをアクティブにしてシートを選ぶ()
    Workbooks("BBB.xls").Activate               'ブックをアクティブにする ※1
    Sheets("SSS").Select                        'シートを選ぶ ※2
End Sub
'-----------------------------------------------------------------------------------------
Sub 指定ブックの指定シートをアクティブにする()
    ブック名 = "BBB"                            '※1
    シート名 = "SSS"                            '※2
    Workbooks(ブック名 & ".xls").Worksheets(シート名).Activate
End Sub
'-----------------------------------------------------------------------------------------
Sub 指定ブックの指定シートの選択状態を調べる()
    ブック名 = "BBB" & ".xls"                   '※1
    シート名 = "SSS"                            '※2
    For Each 各シート In Workbooks(ブック名).Windows(1).SelectedSheets '※7
        If 各シート.Name = シート名 Then
            MsgBox 各シート.Name & " は選択されています。"
            Exit For
        End If
    Next
End Sub
'=========================================================================================
<コメント>
※1 BBBにはブック名を記入
※2 SSSにはシート名を記入
※3 Cにはフォルダが保存されているドライブを記入
※4 FFFにはブックが保存されているフォルダ名を記入
※5 F22には移動先のフォルダ名を記入
※6 B22には新しいブック名を記入
※7 アクティブウィンドウは常にWindows(1)と記述


8) ブック・シート名を取得・変更 もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ブック名シート名を取得する()
    ブック名 = ActiveWorkbook.Name
    シート名 = ActiveWorkbook.ActiveSheet.Name  'シートタブに表示される名前
    シートのコード名 = ActiveWorkbook.ActiveSheet.CodeName 'オブジェクト名
End Sub
'-----------------------------------------------------------------------------------------
Sub ブック内の全部のシート名を取得する()
    Worksheets("NNN").Select                    '※7 取得したシート名を記入するシート選択
    For I = 1 To Worksheets.Count               '※8 ワークシートの数だけ繰り返す
        Cells(I, 1).Value = Worksheets(I).Name  '※9 取得したシート名をセルへ記入する
    Next
End Sub
'-----------------------------------------------------------------------------------------
Sub ブック名を変更する()
    Name "C:\FFF\BBB.xls" As "C:\FFF\B22.xls"   '※1,3,4,6,10,11
End Sub
'-----------------------------------------------------------------------------------------
Sub シート名を変更する()
    Worksheets("Sheet1").Name = "新しい名前"    '※11
End Sub
'=========================================================================================
<コメント>
※1 BBBにはブック名を記入
※2 SSSにはシート名を記入
※3 Cにはフォルダが保存されているドライブを記入
※4 FFFにはブックが保存されているフォルダ名を記入
※5 F22には移動先のフォルダ名を記入
※6 B22には新しいブック名を記入
※7 NNNには取得したシート名を記入するためのシート名を記入
※8 Worksheets.CountをSheets.Countに変えるとワークシート以外も取得可能
※9 Worksheets(I).Nameについても※8と同様
※10 Macintoshではパスの記述が異なる
※11 ブック名またはシート名に使用禁止文字が含まれているか31文字超の場合は変更されない
   使用禁止文字とは : \ / ? * [ ]  および 空白


9) ブックのシート数を取得 もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub アクティブブックのワークシート数を取得する()
    シート数 = ActiveWorkbook.Worksheets.Count
End Sub
'-----------------------------------------------------------------------------------------
Sub 指定ブックのワークシート数を取得する()
    ブック名 = "BBB" & ".xls"                   '※1
    シート数 = Workbooks(ブック名).Worksheets.Count
End Sub
'=========================================================================================
Sub アクティブブックのシート数を取得する()
    シート数 = ActiveWorkbook.Sheets.Count      '※2
End Sub
'-----------------------------------------------------------------------------------------
Sub 指定ブックのシート数を取得する()
    ブック名 = "BBB" & ".xls"                   '※1
    シート数 = Workbooks(ブック名).Sheets.Count '※2
End Sub
'=========================================================================================
Sub アクティブブックの選択されているシート数を取得する()
    シート数 = ActiveWindow.SelectedSheets.Count '※2
End Sub
'=========================================================================================
<コメント>
※1 BBBにはブック名を記入
※2 ワークシートとグラフシートが対象


10) ブックのプロパティの設定・取得 もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ブックのプロパティを設定する()
    ActiveWorkbook.BuiltinDocumentProperties("Title").Value = "すぐマク" 'タイトル ※1
    ActiveWorkbook.BuiltinDocumentProperties("Author").Value = "永井善王" '作成者
    URL = "http://www.geocities.jp/happy_ngi/"
    ActiveWorkbook.BuiltinDocumentProperties("Hyperlink Base").Value = URL
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックのプロパティを取得して表示する()
    MsgBox ActiveWorkbook.BuiltinDocumentProperties(3).Value '作成者 ※1
    MsgBox ActiveWorkbook.BuiltinDocumentProperties(7).Value '最終更新者
    MsgBox ActiveWorkbook.BuiltinDocumentProperties(11).Value '作成日時
    MsgBox ActiveWorkbook.BuiltinDocumentProperties(12).Value '更新日時
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックの作成者の名前を操作する()
    作成者名 = ActiveWorkbook.Author            '取得する
    ActiveWorkbook.Author = ""                  '削除する
    ActiveWorkbook.Author = 作成者名            '設定する
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックのパスを含めたブック名を表示する()
    MsgBox ActiveWorkbook.FullName
End Sub
'=========================================================================================
<コメント>
※1 BuiltinDocumentPropertiesプロパティのインデックス値とプロパティ名は こちら


11) ファイル形式を取得する もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ファイル形式を取得する()
    値 = ActiveWorkbook.FileFormat
End Sub
'-----------------------------------------------------------------------------------------
Sub 指定されたファイルの形式と種類を取得して表示する()
    定数 = "?"
    種類 = "?"
    値 = ActiveWorkbook.FileFormat          'ファイル形式の値を取得する
'
    If 値 = xlWorkbookNormal Then           '-4143
        定数 = "xlWorkbookNormal"
        種類 = "Microsoft Excelブック (*.xls)"
    ElseIf 値 = xlExcel5 Then               '39
        定数 = "xlExcel5"
        種類 = "Microsoft Excel5.0/95ブック (*.xls)"
    ElseIf 値 = xlExcel9795 Then            '43
        定数 = "xlExcel9795"
        種類 = "Microsoft Excel97-2000および5.0/95ブック (*.xls)"
    End If
'
    タイトル = "作業中のブックの現在のファイル形式は"
    メッセージ = "FileFormatの定数: " & 定数 & "   値: " & 値 & _
                Chr(13) & Chr(13) & "ファイルの種類: " & 種類
    MsgBox メッセージ, vbInformation, タイトル
End Sub
'=========================================================================================
<コメント>
※1 FileFormatプロパティの定数と値は こちら


12) ブックを保護・非保護 もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ブックの保護_非保護()
    ActiveWorkbook.Unprotect                    'ブック非保護
    ActiveWorkbook.Protect Structure:=True, Windows:=False  'ブック保護
End Sub
'=========================================================================================


13) シートを保護・非保護 もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub シートの保護_非保護()
    ActiveSheet.Unprotect                       'シート非保護
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'シート保護
    ActiveSheet.Protect UserInterfaceOnly:=True '画面上からの変更だけ保護 ※1
End Sub
'-----------------------------------------------------------------------------------------
Sub シートの保護_非保護_パスワード付き()
    ActiveSheet.Unprotect "PW"                  '※2
    ActiveSheet.Protect "PW", DrawingObjects:=True, Contents:=True, Scenarios:=True '※2
End Sub
'=========================================================================================
<コメント>
※1 マクロからの変更は可能。保存して閉じると再度実行しないとマクロからも変更ができなくなる
※2 PWにはパスワードを記入


14) ブックの複写・削除・移動・変更 もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ブックを複写する()
    FileCopy "C:\FFF\BBB.xls", "C:\F22\B22.xls" '※1,3,4,5,6
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックを削除する()
    Kill "C:\FFF\BBB.xls"                       '※1,3,4
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックを移動する()
    Name "C:\FFF\BBB.xls" As "C:\F22\BBB.xls"   '※1,3,4,5
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックを移動しブック名を変更する()
    Name "C:\FFF\BBB.xls" As "C:\F22\B22.xls"   '※1,3,4,5,6
End Sub
'=========================================================================================
<コメント>
※1 BBBにはブック名を記入
※2 SSSにはシート名を記入
※3 Cにはフォルダが保存されているドライブを記入
※4 FFFにはブックが保存されているフォルダ名を記入
※5 F22には複写・移動先のフォルダ名を記入
※6 B22には新しいブック名を記入


15) ブックのアクセス権変更 もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ブックを読み取り専用に設定する()
    ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
End Sub
'-----------------------------------------------------------------------------------------
Sub ブックを書き込み可能に設定する()
    ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite '※1,2
End Sub
'=========================================================================================
<コメント>
※1 読み取り専用から書き込み可能に変更すると、再読み込みされる
※2 書き込みパスワードの指定も可能


16) シート切替時の自動処理 もくじへ 使用可能なExcelのバージョン
'=========================================================================================
'シートがアクティブになったときに実行されるイベントマクロ
'
Private Sub Workbook_SheetActivate(ByVal シート名 As Object) '※1
    MsgBox "アクティブにされたシート名は、" & シート名.Name
End Sub
'=========================================================================================
'シートがアクティブでなくなったときに実行されるイベントマクロ
'
Private Sub Workbook_SheetDeactivate(ByVal シート名 As Object) '※1
    MsgBox "非アクティブにされたシート名は、" & シート名.Name
End Sub
'=========================================================================================
<コメント>
※1 ワークブックのコード画面に作成する


17) シートを隠す もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ユーザーが再表示できないようにシートを隠す()
    Worksheets("SSS").Visible = xlVeryHidden       '※1
End Sub
'-----------------------------------------------------------------------------------------
Sub シートを隠す()
    Worksheets("SSS").Visible = False              '※1
End Sub
'-----------------------------------------------------------------------------------------
Sub 隠したシートをもどす()
    Worksheets("SSS").Visible = True               '※1
End Sub
'=========================================================================================
<コメント>
※1 SSSにはシート名を記入


18) シートを削除する もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ワークシート名を指定して削除する()
    Application.DisplayAlerts = False           '※4 注意メッセージを表示しない
    シート名 = "SSS"                            'ワークシート名をセットする ※1
    Worksheets(シート名).Delete                 'ワークシートを削除する ※2
    Application.DisplayAlerts = True            '※4 注意メッセージを表示する
End Sub
'-----------------------------------------------------------------------------------------
Sub 現在アクティブなワークシートを削除する()
    Application.DisplayAlerts = False           '※4
    シート名 = ActiveSheet.Name                 'アクティブシート名を取得する
    Worksheets(シート名).Delete                 'ワークシートを削除する ※2
    Application.DisplayAlerts = True            '※4
End Sub
'-----------------------------------------------------------------------------------------
Sub 現在アクティブなシートを削除する()
    Application.DisplayAlerts = False           '※4
    シート名 = ActiveSheet.Name                 'アクティブシート名を取得する ※3
    Sheets(シート名).Delete                     'シートを削除する ※3
    Application.DisplayAlerts = True            '※4
End Sub
'-----------------------------------------------------------------------------------------
Sub シートを選択してから削除する()
    Application.DisplayAlerts = False           '※4
    Sheets("SSS").Select                        'シートを選択する ※1、3
    ActiveWindow.SelectedSheets.Delete          '選択されたシートを削除する ※3
    Application.DisplayAlerts = True            '※4
End Sub
'=========================================================================================
<コメント>
※1 SSSにはシート名を記入
※2 ワークシート以外のシートが指定されているとエラーになる
※3 ワークシート以外のシートも可能
※4 注意メッセージを表示したくない場合に指定する (関連ページはこちら


19) シートを追加する もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub 新しいワークシートをアクティブシートの前へ追加する()
    Sheets("SSS").Select                        '※1
    ActiveWorkbook.Worksheets.Add               'アクティブシートの前へ追加する
End Sub
'-----------------------------------------------------------------------------------------
Sub 新しいワークシートをアクティブシートの後へ追加する()
    Sheets("SSS").Select                        '※1
    シート名 = ActiveSheet.Name                 'アクティブシート名を覚える
    Worksheets.Add after:=Worksheets(シート名)  'アクティブシートの後へ追加する
End Sub
'-----------------------------------------------------------------------------------------
Sub 新しいワークシートを最後のシートの後へ追加する()
    Sheets("SSS").Select                        '※1
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count) '最後のシートの後へ追加する
End Sub
'=========================================================================================
<コメント>
※1 SSSにはシート名を記入


20) シート見出しをスクロールする もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Private Sub シート見出しを先頭までスクロールする()
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
End Sub
'-----------------------------------------------------------------------------------------
Private Sub シート見出しを末尾までスクロールする()
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
End Sub
'-----------------------------------------------------------------------------------------
Private Sub シート見出しを前方にスクロールする()
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
End Sub
'-----------------------------------------------------------------------------------------
Private Sub シート見出しを後方にスクロールする()
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
End Sub
'=========================================================================================


21) シート見出しの色を設定する もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Private Sub シート見出しの色を赤にする()
    ActiveWorkbook.Sheets("SSS").Tab.ColorIndex = 3 '※1、2
End Sub
'-----------------------------------------------------------------------------------------
Private Sub シート見出しの色をなしにする()
    ActiveWorkbook.Sheets("SSS").Tab.ColorIndex = -4142 '※1、2
End Sub
'-----------------------------------------------------------------------------------------
Private Sub シート見出しの色がなしなら黄色にする()
    If Worksheets("SSS").Tab.ColorIndex = xlColorIndexNone Then '※1
        ActiveWorkbook.Sheets("SSS").Tab.ColorIndex = 6 '※1、2
    End If
End Sub
'=========================================================================================
<コメント>
※1 SSSにはシート名を記入
※2 カラーパレットのインデックス番号
   (1=黒、2=白、3=赤、4=明るい緑、5=青、6=黄、7=ピンク、-4142=なし、等)



22) シートの背景のグラフィックスを設定する もくじへ 使用可能なExcelのバージョン
'=========================================================================================
Sub ワークシートの背景のグラフィックスを設定する()
    フルパス = "C:\YN2007USA_a.jpg"             '※1
    Worksheets("Sheet1").SetBackgroundPicture Filename:=フルパス
End Sub
'画像ファイルのフルパス
'-----------------------------------------------------------------------------------------
Sub ワークシートの背景のグラフィックスを削除する()
    Worksheets("Sheet1").SetBackgroundPicture Filename:=vbNullString
End Sub
'=========================================================================================
<コメント>
※1 ""内には画像ファイルのフルパスを記入