OFFice 2003 の場合 表示 ツールバー Visual Basic デザインモード デザインモードの終了 http://www.big.or.jp/~seto/vbaref/contents.htm -------------------------------------------------- Office365 [開発] タブを有効にするには [ファイル] タブの [オプション] をクリックして [オプション] ダイアログ ボックスを表示します。 ダイアログ ボックスの左側にある [リボンのユーザー設定] を選択します。 ダイアログ ボックスの左側にある [コマンドの選択] で、[基本的なコマンド] を選択します。 ダイアログ ボックスの右側にある [リボンのユーザー設定] のドロップダウン リストから [メイン タブ] を選択し、[開発] チェック ボックスをオンにします。 [OK] を選択します。 ------------------------------------------------------------ https://excel-ubara.com/excelvba1/ Sub カレンダー入力() ' ' カレンダー入力 Macro ' 選択セルの日付から31日分のカレンダーを入力する。 ' ActiveCell.Range("A1:A31").Select Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _ xlDay, Step:=1, Trend:=False Selection.NumberFormatLocal = "mm/dd (aaa)" End Sub ------------------------------------------------------ Sub Sub001() ' カレンダー入力 Dim dd() As String Dim i As Integer ' A1 の日付から計算します If "" = Range("A1").Value Or False = IsDate(Range("A1").Value) Then Range("A1").Value = Format(Date, "yyyy/mm/dd") ' False True dd = Split(Range("A1").Value, "/") Range("E1").Value = dd(0) Range("F1").Value = dd(1) Range("G1").Value = dd(2) ' 縦方向 Range("B4").Select For i = 1 To 31 If IsDate(dd(0) & "/" & dd(1) & "/" & i) Then ActiveCell.Offset(0, 0).Value = dd(0) & "/" & dd(1) & "/" & i 'Selection.NumberFormatLocal = "M/d (aaa)" Selection.NumberFormatLocal = "mm/dd(aaa)" Else ActiveCell.Offset(0, 0).Value = "" End If ActiveCell.Offset(1, 0).Select Next i ' 横方向 Range("B35").Select For i = 1 To 31 If IsDate(dd(0) & "/" & dd(1) & "/" & i) Then ActiveCell.Offset(0, 0).Value = dd(0) & "/" & dd(1) & "/" & i Selection.NumberFormatLocal = "M/d (aaa)" 'Selection.NumberFormatLocal = "mm/dd(aaa)" Else ActiveCell.Offset(0, 0).Value = "" End If ActiveCell.Offset(0, 1).Select Next i End Sub Sub Sub002() ' セルの値や書式情報を削除します Range("B4:B34").Clear End Sub ------------------------------------------------------ Sub test01() Range("B2").Value = "漢字" Sheet2.Name = Range("B2").Value End Sub ----------------------------------------------------------------- Sub 新規シート() ' ' 新規シート Macro ' 成績表をコピーして、入力用の成績表のデータをクリアする。 ' ' Sheets("入力").Copy After:=Sheets(2) ActiveSheet.Shapes(1).Delete ActiveSheet.Name = Range("B1").Value Sheets("入力").Select Range("C4:E18").Select Selection.ClearContents ' Range("B1").Select ' Selection.ClearContents Range("B1").Value = "第x週" End Sub Sub test02() Range("B2").Value = "入力2" ' Worksheets(1).Name = Range("B2").Value Worksheets(1).Copy After:=Worksheets(1) Worksheets(2).Name = Range("B2").Value Worksheets(1).Select Range("B1").Value = "第x週" End Sub Sub test03() ' 表全体を参照する例です。 Dim A As Range Dim B As Long Dim C As Long ' アクティブセル領域の指定の例です。 Set A = Range("B5").CurrentRegion B = A.Rows.Count C = A.Columns.Count A.Rows(B).Font.Bold = True A.Columns(C).Font.Bold = True Set A = Nothing End Sub Sub test04() ' 縦方向にループする例です。 Range("B4").Select Do While ActiveCell.Value <> "" ActiveCell.Offset(0, 0).Value = ActiveCell.Value & " 様" ActiveCell.Offset(1, 0).Select Loop End Sub Sub test5() ' 横方向にループする例です。 Range("A3").Select Do While ActiveCell.Value <> "" ActiveCell.Offset(0, 0).Value = ActiveCell.Value & " 様" ActiveCell.Offset(0, 1).Select Loop End Sub Sub test6() ' セル範囲のセル数など Range("B23") = Range("B4:E18").Count Range("B24") = Range("B4:E18").Rows.Count Range("B25") = Range("B4:E18").Columns.Count Range("A23") = "セル数" Range("A24") = "行数" Range("A25") = "列数" Range("B4:E18").Select End Sub Sub test1() ' ワークシートの保存についての例。 Range("B25").Value = "d:\temp\test001.xls" Worksheets(1).SaveAs Filename:=Range("B25").Value Workbooks("Book002.xls").SaveAs Filename:=Range("B25").Value Application.Quit ' Windows(z).Close True End Sub Sub test01() ' オートフィルの例です。 Range("B3").Value = 1 Range("B4").Value = 2 Range("B3:B4").AutoFill Destination:=Range("B3:B10") Range("C3").Value = "日" Range("C3").AutoFill Destination:=Range("C3:C10") End Sub Sub t01() ' Yes / No の入力例です。 Dim i As Integer i = MsgBox("test ?", vbYesNo, "test2") i = MsgBox("test ?", vbOKOnly, "test2") If i = vbYes Then Range("A2").Value = "Yes" Else Range("A2").Value = "No" End If End Sub If (Range("E12").Value - Range("G12").Value) >= 0 Then Range("I12").Value = Range("E12").Value - Range("G12").Value Else Range("I12").Value = "" End If If Range("I19").Value = "" Then Range("J19").Value = "" Else Range("J19").Value = Range("I19").Value * 1200 End If Range("E15").Value = Range("J13").Value If ActiveCell.Value = "①データのクリア" Then ＜使用例 セル「A1」を黄色で塗りつぶす＞ Worksheets("Sheet1").Range("A1").Interior.Color = RGB(255, 255, 0) Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Range("I1").Value = Sub02() If Range("E10").Value = Range("E11").Value Then ddd = Sub01("d:\temp\keisan003.txt", 0) chk = MsgBox("データのダウンロードを実行されましたか？", vbYesNo, ddd & " のデータ？ （日時確認）") If chk = vbYes Then Dim fileNo As Integer Dim buf Dim buf2 Function F01(z As String) As Integer F01 = Len(z) End Function ' データを抽出する Sub Sub001() Range("A3").AutoFilter field:=4, Criteria1:=88 End Sub ' ブックを開いた時に処理を実行する Private Sub Workbook_Open() Worksheets("入力").Select End Sub Sub Sub004() ' データの並び替えの例 Worksheets("入力").Activate Worksheets("入力").Range("A4:F18").Sort Key1:=Range("E4"), order1:=xlDescending 'Worksheets("入力").Range("A4:F18").Sort Key1:=Range("A4"), order1:=xlAscending End Sub ' 1/2 ダブルクリックして下に入力する。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim i As Integer Dim j As Integer 'Range("A25").Value = ActiveCell.Column 'Range("A26").Value = ActiveCell.Row If 2 = ActiveCell.Column Then i = MsgBox(ActiveCell.Value, vbOKOnly, "シート２に入力") ' If "" = Sheet2.Range("B4").Offset(j, 0).Value Then Sheet2.Range("B4").Offset(j, 0).Value = ActiveCell.Value Sheet2.Range("B4").Offset(j, 1).Value = ActiveCell.Offset(0, 1).Value Sheet2.Range("B4").Offset(j, 2).Value = ActiveCell.Offset(0, 2).Value Sheet2.Range("B4").Offset(j, 3).Value = ActiveCell.Offset(0, 3).Value Sheet2.Range("B4").Offset(j, 4).Value = ActiveCell.Offset(0, 4).Value End If ' Do Until "" = Sheet2.Range("B7").Offset(j, 0).Value j = j + 1 Loop Sheet2.Range("B7").Offset(j, 0).Value = ActiveCell.Value Sheet2.Range("B7").Offset(j, 1).Value = ActiveCell.Offset(0, 1).Value Sheet2.Range("B7").Offset(j, 2).Value = ActiveCell.Offset(0, 2).Value Sheet2.Range("B7").Offset(j, 3).Value = ActiveCell.Offset(0, 3).Value Else i = MsgBox(ActiveCell.Value, vbOKOnly, "氏名をダブルクリック") End If End Sub ' 2/2 こちらに入力する。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim j As Integer If ActiveCell.Value = "Ｓ２クリア" Then Sheet2.Range("B4").Offset(j, 0).Value = "" Sheet2.Range("B4").Offset(j, 1).Value = "" Sheet2.Range("B4").Offset(j, 2).Value = "" Sheet2.Range("B4").Offset(j, 3).Value = "" Sheet2.Range("B4").Offset(j, 4).Value = "" For j = 0 To 10 Sheet2.Range("B7").Offset(j, 0).Value = "" Sheet2.Range("B7").Offset(j, 1).Value = "" Sheet2.Range("B7").Offset(j, 2).Value = "" Sheet2.Range("B7").Offset(j, 3).Value = "" Next j i = MsgBox("シート２クリア", vbOKOnly, "シート２クリア") End If End Sub ' ワークシートの SelectionChange または Change に入れる（入力すると計算される） Private Sub Worksheet_SelectionChange(ByVal Target As Range) Range("D2") = 60 * Val(Left(Range("D1").Text, 1)) + Val(Right(Range("D1").Text, 2)) End Sub Sub Sub01() 'Range("A2") = Len(Range("D1").Text) Range("D2") = 60 * Val(Left(Range("D1").Text, 1)) + Val(Right(Range("D1").Text, 2)) 'Range("A4") = Val(Right(Range("D1").Text, 2)) End Sub ' 最初に自動起動させる Private Sub Workbook_Open() Call UserForm1.Show End Sub -------------------------------------------- ブックを開いたときにユーザーフォームを表示し、一定時刻が経過したら自動的に閉じる方法をご紹介します。アプリケーション起動時にロゴが表示されるのと同じような動作をさせることができます。 (1)まず、表示したいフォームを用意します。このフォームを「UserForm1」とします。 プックオープン時に発生する「Open」イベントで、ユーザーフォーム「UserForm1」を開きます。 ●ThisWorkbookモジュール● Private Sub Workbook_Open() UserForm1.Show End Sub (2)ユーザーフォームがアクティブになったときに発生する「Activate」イベントで、指定した時刻にマクロを実行する処理を記述します。 特定の日時、または特定の期間の経過後にマクロを実行するには、ApplicationオブジェクトのOnTimeメソッドを使用します。 ここでは、2秒後に「KillTheForm」というマクロを呼び出します。 ●UserFomr1のフォームモジュール● Private Sub UserForm_Activate() Application.OnTime Now + TimeValue("00:00:02"), "KillTheForm" End Sub (3)標準モジュールにユーザーフォームをメモリから削除するマクロを作成します。 ●標準モジュール● Sub KillTheForm() Unload UserForm1 End Sub ●補足● UserForm1をアプリケーションモーダルで表示します。ユーザーフォーム表示中はExcelの操作はできません。ただし、［×］ボタンをクリックするとKillTheFormマクロの実行前にユーザーフォームを閉じることができます。 ' ファイルの有る無し等 Private Sub UserForm_Click() Dim stra() As String Dim fileNo As Integer Dim buf Dim i As Integer Dim j As Integer Dim k As Integer Dim FSO As Object Dim Tgt As String Dim z As String Tgt = "d:\vl60\data\yasumi9.txt" Set FSO = CreateObject("Scripting.FileSystemObject") If FSO.FileExists(Tgt) Then Label1.Caption = Tgt Else z = ThisWorkbook.Path If "\" <> Right(z, 1) Then z = z & "\" Tgt = z & "yasumi.txt" If FSO.FileExists(Tgt) Then Label1.Caption = Tgt Else '.Path Label1.Caption = "nasi" End If End If End Sub