1行マクロのサンプル集
ご自由にお使いください。でも、動かないかも知れませんよ
区切り文字等は見辛いので、大文字で表記してあります。


’セルを読み上げる

Selection.Speak

’差込印刷

Sub 印刷()
    Dim 人数 As String
    Sheets("名簿").Select
    人数 = Range("A2").CurrentRegion.Rows.Count
    For Count = 1 To 人数 - 1
        Sheets("印刷シート").Select
        Range("番号").Select
        N = N + 1
'番号を表示するセルに「番頭」と名前が付けてあるだけ
        Range("番号").Value = Worksheets("名簿").Cells(N + 1, 1)

'実際に印刷する時は、すぐ下を有効にする
        'ActiveWindow.SelectedSheets.PrintOut Copies:=1

'実際に印刷する時は、すぐ下を無効にする
        MsgBox "印刷中"
    Next
End Sub

’任意な名前を付けて保存

Sub 任意な名前を付けて保存()
    Dim myFileName As String
    Dim MyMH As Integer

    MyMH = Sheet1.Cells(4, 3).Value
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:="C:\給料\" & MyMH & "月支給給料.xls"
    Application.DisplayAlerts = True
End Sub

例:Cドライブの「給料」フォルダに、sheet1のCell(4,3)に入力された値を”月支給給料”という名前の前に引っ付けて保存する。

FDにコピーを作成

Sub FDにコピーを作成()
Dim Myans As Integer
Dim Source, Destination As Variant

Source = "C:\仕訳\仕訳帳.xls"    ’コピー元フォルダとファイル名を指定
Destination = "A:\仕訳帳bck.xls"   ’コピー先装置Aとファイル名を指定

Myans = MsgBox("初期化済みのFDを挿入してください。", vbOKCancel, "コピーの作成")
    If Myans = 2 Then
    Exit Sub
End If

    FileCopy Source, Destination

        MsgBox "FDへのバックアップが終了しました。FDは保管しておいてください。"  ’単にメッセージを出すだけ(^^)

End Sub

特定のフォルダの中のファイル名を書き出す


Sub 特定フォルダ内のファイル名を書き出す()

Dim myDir As String   'パスを格納するための変数
Dim myFile As String  'ファイル名を格納するための変数

Sheet1.Range("k1:k13").Select   'データを書き出す範囲を選択しておいて
    Selection.ClearContents       'セルのデータをクリア

myDir = "C:\指定するフォルダ名\"   'パスを設定

    If myDir Like "*\\" Then myDir = CurDir
        myFile = Dir(myDir, vbNormal)     '最初のファイル名を返す
        Range("G1").Value = myDir       '見出しにパスを表示
        Range("G2").Select            'ファイルを書き出す位置
    Do Until myFile = ""           'ファイルがなくなるまでDo-Loopを繰り返す

                   
            If myFile Like "*.xls" Or myFile Like "*.xls" Then   '文字列を比較するLike演算子で "*.xls" 又は "*.xls" のとき
                ActiveCell.Value = myFile
                ActiveCell.Offset(1, 0).Select              'ファイル名を書き出す
            End If

        myFile = Dir '''次のファイル名を返す

    Loop
End Sub
 

時刻をファイル名に付けて保存する

○○.xls と言うファイルに、パソコンに内臓された時計の時刻をくっつけてデスクトップ上に保存する場合、

ActiveWorkbook.SaveAs FileName:=”C:¥デスクトップ¥○○” & Format$(Now.”YYMMDDhhnnss”) & ”.xls”

最終端のセルを選択する

ActiveCell.SpecialCells(xlLastCell).Select  ’Ctrlキーを押しながらEndキーを押す事と同意

Range("a65536").End(xlUp).Offset(1, 0).Activate  ’A列の最終行の一つ下のセルを選択する

’My Documents に新しいフォルダを作る (XP)

ChDir "C:\Documents and Settings\Owner\My Documents"
MkDir "●●"              '●●と言うフォルダを作る

全てのシートのアクティブセルをA2に揃える

Sub To_Home()
    Dim WS As Variant
        For Each WS In Worksheets
            If Sheets(WS.Name).Visible = True Then
            Sheets(WS.Name).Select
            Range("A2").Select
        End If
    Next
Sheets(1).Select
End Sub

任意の列を基準に、空白のセルを含む行を削除する

 例えば、列Aに空白のセルがある場合、その空白のセルを含む行全体を削除する場合、

 Columns("a:a").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 

アクティブなセルを含む列全体を選択する

ActiveCell.EntireColumn.Select

全てのシートのカーソルをホームポジションに(A1)へ移動する

Sub To_Home()

  Dim ws As Variant
  For Each ws In Worksheets
    If Sheets(ws.Name).Visible = True Then
        Sheets(ws.Name).Select
        Range("A1").Select
    End If
  Next
  Sheets(1).Select

End Sub

 

シート名を取得し一覧に書き出す

Sub ブック内の全部のシート名を取得する() 
    Worksheets("任意のシート").Select   ' 取得したシート名を記入するシートを選ぶ 
        For I = 1 To Worksheets.Count   ' ワークシートの数だけ繰り返す 
        Cells(I, 1).Value = Worksheets(I).Name   ' 取得したシート名をセルへ記入する 
    Next 
End Sub

リストを表示する

 作成中の表で、マウスの右クリックで「リストから選択」、あるいは、キーボードから「Alt」+「↓」でリストが表示されますが、これをマクロでかくと、
SendKeys "%{DOWN}"

 例えばシートのモジュール
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Select Case Target.Column
  Case Is = 5
     SendKeys "%{DOWN}"
  Case Is = 6
     SendKeys "%{DOWN}"
   
End Select
 End Sub

セルを選択したときに何かをする

ワークシートの Change イベントを利用します。 設定したいシートのシートモジュールに以下のコードを記述します。

Private Sub Worksheet_Change(ByVal Target As Range)
 好きなコードを記入
End Sub

 例えば、ある表があり、横へ入力していき、6列目までの入力が済んだら、1行下のA列へカーソルを移動させるには、

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'セルの位置を確認し、それに応じて特定の列にセルを移動させる
    Select Case Target.Column
'G列以降にセルがあれば、A列に移動
    Case Is >= 7
        Range("a65536").End(xlUp).Offset(1, 0).Activate
    End Select
End Sub

数式を表示させる(ユーザー定義関数として使用)

Funciton 数式表示(Rng As Range) As String
    数式表示=Rng.Formula
End Function

メッセージボックスの種類  MSGBOX関数

 MSGBOX(Prompt,Buttons,Title,HelpFile,Context)

 Prompt  -----表示する文字列
 Buttons  -----定数:ボタンの種類や個数 [省略可]  ------省略した場合は「OK」ボタンのみが表示
  Title  -------メッセージボックスのタイトルを表す文字列 [省略可]
 Helpfile  ----ヘルプファイルのファイル名 [省略可]
 Context  -----ヘルプトピックスに指定したコンテキスト番号 [省略可]

ボタンの種類を複数指定する事も出来るが,そのときは下記の各グループで1つずつしか指定できない。
ボタンの指定を省略すると,「OK」ボタンのみ表示される。(規定値はvbOKOnly)


メッセージボックスのボタンの種類や個数を示す定数の表

定数 内容
vbOKONLY 0 「OK」ボタンのみ表示する
vbOKCancel 「OK」ボタンと「キャンセル」ボタン
vbAbortRetrylgnore 2 「中止」「再試行」「無視」の3個
vbYesNoCancel 3 「はい」「いいえ」「キャンセル」の3個
vbYesNo 4 「はい」「いいえ」
vbRetryCancel 5 「再試行」「キャンセル」
vbCritical 16 警告メッセージアイコンを表示
vbQuestion 32 問い合わせメッセージアイコンを表示
vbExclamation 32 注意メッセージアイコンを表示
vbInformation 64 情報メッセージアイコンを表示
vbDefaultButton1 0 第1ボタンを標準ボタンにする
vbDefaultButton2 256 第2ボタンを標準ボタンにする
vbDefaultButton3 512 第3ボタンを標準ボタンにする
vbDefaultButton4 768 第4ボタンを標準ボタンにする
vbApplicationModal 0 アプリケーションモーダル
vbSystemModal 4096 システムモーダル
vbMsgBoxHelpButton 16384 ヘルプボタンを追加
vbMsgBoxSetForeground 65536 最前面のウィンドウとして表示
vbMsgBoxRight 524288 テキストを右寄せで表示
vbMsgBoxRtlReading 1048576 テキストを右から左の方向で表示


MsgBox関数の戻り値の表 (表示したボタンをクリックする事によって発生する戻り値)

動作 定数 戻り値
「OK」 vbOK 1
「キャンセル」 vbCancel 2
「中止」 vbAbort 3
「再試行」 vbRetry 4
「無視」 vbgnore 5
「はい」 vbYes 6
「いいえ」 vbNo 7

 

文字を半角に統一させる

 住所録などで、電話番号の列が、数字の全角、半角が混在していて見難い時に、全ての電話番号を半角に統一するとき。

 For i =初期値 To 最終値
        Cells(i,*)=StrConv(Cells(i,*),vbNarrow
 Next

列Cの2行目から電話番号が入力されており,そのデーター数が50件ある場合、その電話番号の入力されているC列を全て半角に統一する場合には、

    For i =1 To 50
        Cells(i + 1,3)=StrConv(Cells(i +1,3),vbNarrow
   Next

 因みに、StrConv は文字列を変換するための命令。

vbWide 全角文字に変換
vbNarrow  半角文字に変換
vbUpperCase 大文字に変換
vbLowerCase 小文字に変換
vbProperCase 先頭の文字を大文字に変換
vbKatakana カタカナに変換
vbHiragana ひらがなに変換

    

ユーザーフォームをモードレス表示にする

 ユーザーフォームの表示には、モーダルとモードレスの2通りの表示方法がある。 
 モーダルとは、ユーザーフォームを閉じないとシート等の操作が出来ない表示形態で、モードレスはユーザーフォームを表示していてもシート等の操作ができる表示形態である。

UserForm1.Show vbModeless

 

印刷プレビューを出す 

 Application.Dialogs(xlDialogPrintPreview).Show

トグルボタンの使用例

 一つのボタンを押してへこましたり戻したり、そんな使い方をするのがトグルボタン。
ツールボックスを右クリックして、コントロールツールボックスにチェックを入れて、シート上にコントロールツールボックスを出します。 次に、トグルボタンをクリックして、シート上の任意の場所でドラッグしてトグルボタンを出現させます。
 で、そのボタンをダブルクリックして下記のように書くかコピーして貼り付けてください。
 後は、実行後のお楽しみ。

Private Sub ToggleButton1_Click()
    If ToggleButton1.Value = True Then
    ToggleButton1.Caption = "書く"
    Range("a1").Delete
Else
    ToggleButton1.Caption = "消す"
    Range("a1") = ActiveSheet.Name
    End If
End Sub

 

’1月から12月のシートのヘッダーに 「Print Date] と表示させる

For m = 1 To 12
Worksheets(m & "月").Select

With ActiveSheet.PageSetup
.RightHeader = "PrintDate"
End With
Next m

 

印刷するときのシートを横に設定

With ActiveSheet.PageSetup
    .Orientation = xlLandscape
    .Zoom = 100
End With

印刷するときのシートを縦に設定

With ActiveSheet.PageSetup
    .Orientation = xlPortrait
    .Zoom = 100
End With

 

メッセージボックスの長い文章を改行するには

 ExcelのVBAを書いてるときに、メッセージボックスを出すときがありますよね。
 その時に、長いメッセージを表示する場合に、任意の個所で改行したくありませんか?
実は、わしも苦労しました。 で、判明。

 & Chr(13) &  で文章を繋いで下さい。

msgbox"わしの名前はかめです。今日落花生を食べていたら、3個出てきました。"

これを改行してメッセージボックスを出すには、

msgbox"わしの名前はかめです。"  & chr(13) &  "今日落花生を食べていたら、" & chr(13) &  "3個出てきました。"

 
これで、メッセージボックスは3行に改行されて、見やすくなるでしょう。(恐らく)

 

確認メッセージを出さずにブックを閉じる

Application.DisplayAlerts = False           '確認メッセージを出さない 
ActiveWorkbook.Close 

’保存するなら
ActiveWorkbook.Save

 

ステータスバーに文字を表示する

Application.StatusBar=”実行中,しばしお待ちを!!”

元に戻すには
Application.StatusBar=False

 

’A列の任意の例えば2行目から任意の行までの合計を算出する


Sub 合計表示1()
    'データの最終行を選択
    Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Select
        'ActiveSheet.Rows.Countは、Excel97以降は 65536 になります。
        'Cells(65536, 1).End(xlUp).Select でも同じです。
        '式を入力するための一行下のセルを選択
        ActiveCell.Offset(1, 0).Select

   ’合計式を入れる
    ActiveCell.Formula = "=SUM(A2:A" & ActiveCell.Row - 1 & ")"
End Sub

ちなみに、サンプル式をR1C1形式にすると
    ActiveCell.FormulaR1C1 = _
    "=SUM(R[-1]C:R[-" & ActiveCell.Row - 2 & "]C)"

 

’Dドライブの全てのファイル名をフルパスで書き出すには


Excelにはファイル検索機能が、[ファイル(F)]-[開く(O)] の
「ファイルを開く」ダイアログの[ツール(L)]-[検索(F)] にあります。
この機能は、FileSearchオブジェクトとして提供されています

Sub 特定ドライブのパス付きファイル名全書き出し()
    Sheets("Sheet1").Select
    RAnge("A1").Select
        With Application.FileSearch
        .NewSearch                                 'ファイル検索の条件を既定の設定に戻す。
        .LookIn = "D:\"                            '検索を開始するフォルダーを指定。
        .SearchSubFolders = True             'LookInで指定したフォルダーの
                                                           'サブフォルダーも検索
        .FileType = msoFileTypeAllFiles      'ファイルタイプを指定
        If .Execute() > 0 Then
        MsgBox .FoundFiles.Count & _
        " 個のファイルが見つかりました。"
    For i = 1 To .FoundFiles.Count
        ActiveCell.Value = .FoundFiles(i)
        ActiveCell.Offset(1, 0).Select
    Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With
End Sub

画面をフルサイズで開く

Sub auto_open( ) 
  Application.WindowState = xlMaximized 
End Sub

'コピーを作る。 ハードディスクに  (バックアップじゃなく)

Sub HDにコピーを作る( )
    ActiveWorkbook.SaveCopyAs "C\自分の指定したフォルダの\実行中のファイルのコピー.xls"
    MsgBox "コピーの作成が終了しました。"
End Sub

'コピーを作るその2.  FDに  (バックアップじゃなく)


Sub FDにコピーを作成( )
    MsgBox "初期化済みのFDを挿入してください。"
        ActiveWorkbook.SaveCopyAs "A\実行中のファイルのコピー.xls"
    MsgBox "FDへのコピー作成が終了しました。FDは保管しておいてください。"
End Sub

'自作ツールバーと標準ツールバーを表示する(書式ツールバーは非表示にして)


'標準モジュールに書くよりもThisWorkbookに書いたほうがいいかもしれない
Sub AUTO_OPEN( )
    If Application.CommandBars("Formatting").Visible = True Then
       Application.CommandBars("Formatting").Visible = False
    End If
    If Application.CommandBars("STANDARD").Visible = False Then
       Application.CommandBars("STANDARD").Visible = True
    End If
    Application.CommandBars("自作のツールバー名").Visible = True
    Application.CommandBars("自作のツールバー名").Left = 0
End Sub

'自作ツールバーを左端に表示する-----中途半端な位置に出現しちゃうから

    Application.CommandBars("自作のツールバー名").Left = 0

'自作ツールバーを消して、書式ツールバーを元に戻す

Sub AUTO_CLOSE( )
    Application.CommandBars("Formatting").Visible = True
    Application.CommandBars("自作ツールバー名").Visible = False
End Sub

'セルに値を入力する-------Valueプロパティに値を代入

    セルB2に123を代入するには
   
Range("B2").Value=123
または
    Range("B2")=123

'選択範囲の行列数を取得する

Sub 数の取得 ( )
    行数 = Selection.Rows.Count
    列数 = Selection.Columns.Count
End Sub

'選択範囲の中から文字列を探す

Sub 検索  ( )
    Dim myStr As String
        myStr = InputBox("検索したい文字列を入力してください")
        Selection.Find(What=myStr, After=ActiveCell, LookIn=xlFormulas, _
        LookAt=xlPart, SearchOrder=xlByRows, SearchDirection=xlNext, _
    MatchCase:=False).Activate
End Sub

選択セルを画面の左端に表示させる

Sub 選択セルを左端までスクロール( )
    Application.Goto Reference:=Range("A100"), Scroll:=True
End Sub

'ブックを開いた時、ツールバーの名前を取得しながらかき出して、非表示にして行く

Sub 本来はワークブックのOpenイベントに記載()

Dim myToolBar As CommandBar
Sheets("タイトル").Select
    Range("A40").Select
        For Each myToolBar In Application.CommandBars
            If myToolBar.Name <> "Worksheet Menu Bar" _
                And myToolBar.Visible = True Then
                ActiveCell = myToolBar.Name
                myToolBar.Visible = False
                ActiveCell.Offset(1, 0).Select
            End If
        Next
End Sub


'振り仮名を一発入力  列を選択しておいてから 

Sub  振り仮名( )
    If Selection.Phonetics.Visible = False Then
        Selection.SetPhonetic
        Selection.Phonetics.Visible = True
    END  IF 
End Sub

'目的のファイルを探すとき 

Sub 欲しいファイルは ( )
    MsgBox ("お好きなファイルを選択して下さい!")
    Application.Dialogs(xlDialogOpen).Show
End Sub