Dim wsh As Worksheet Set wsh = ThisWorkbook.ActiveSheet If wsh.ProtectContents Then wsh.Unprotect Password:="Password" End If wsh.Protect Password:="Password" Set wsh = Nothing
※シート保護されていれば保護解除し、最後にシート保護をする。意味無い
@echo off echo. echo ============================================================ echo サービスSQLServerを起動します。 echo. echo 本バッチファイルは管理者権限で実行して下さい。 echo ============================================================ echo. pause echo. echo. echo 処理を開始しました。処理が終了すると本ウィンドウは終了します。 echo. rem ■サービスを起動 net start "SQL Server (SQLEXPRESS)"
※メモ帳で上記をコピペし、拡張子.batで保存。
管理者権限で実行する方法は、右クリックすれば分かる。
Dim c As Range Set c = Thisworkbook.Worksheet("Sheet1").Range("A1") If c.MergeCells Then MsgBox "結合されています。" If c.Areas.Count = 1 And c.Count = 1 Then MsgBox "選択セルは1つです。" If c.Interior.ColorIndex >= 0 Then "背景色が設定されています。" Set c = Nothing
■Sheet1に追加
Option Explicit Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim myCB As CommandBar Dim myCBCtrl As CommandBarControl On Error Resume Next CommandBars("User_Short_Menu").Delete On Error GoTo 0 right_click = False Set target_cell = Target Set myCB = Application.CommandBars.Add(Name:="User_Short_Menu", Position:=msoBarPopup) Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton) myCBCtrl.Caption = "1" myCBCtrl.OnAction = "S_WriteValue" myCBCtrl.FaceId = 41 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton) myCBCtrl.Caption = "2" myCBCtrl.OnAction = "S_WriteValue" myCBCtrl.FaceId = 41 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton) myCBCtrl.Caption = "通常メニュー" myCBCtrl.OnAction = "S_Right_Click" myCBCtrl.FaceId = 31 myCBCtrl.BeginGroup = True '区切り線の表示 '作成したメニューの表示 myCB.ShowPopup If right_click Then Cancel = False Else Cancel = True End If Application.CommandBars("User_Short_Menu").Delete Set target_cell = Nothing End Sub
■標準モジュールに追加
Option Explicit Public target_cell As Range Public right_click As Boolean Private Sub S_WriteValue() target_cell.Value = Application.CommandBars("User_Short_Menu").Controls.Item(Application.Caller(1)).Caption End Sub Private Sub S_Right_Click() right_click = True End Sub
'ファイルパス、ファイル名+拡張子の状態からファイル名だけを取り出す処理。 '[\]でSplitをかけて最後を取得、[.]でSplitをかけて最初を取得すればOK Function getFileName(file_path) As String Dim temp As String Dim tmp_array2 As Variant, tmp_array1 As Variant tmp_array1 = Split(file_path, "\") temp = tmp_array1(UBound(tmp_array1)) If temp = "" Then Exit Function tmp_array2 = Split(temp, ".") temp = tmp_array2(LBound(tmp_array2)) getFileName = temp '戻り値 End Function
Dim wb As Workbook, wsh As Worksheet Set wb = Workbooks(file_name) Set wsh = wb.Sheets(1) 'シート1枚目 '同じ名前のシートがあっても「シート名(2)」とかになってコピーされる。 wsh.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) '終了処理 wb.Close 'ファイルを閉じる。 Set wsh = Nothing Set wb = Nothing
※そのままでは動かないと思うので、試行錯誤してください。
file_name = Dir(target_dir & "*.csv") Do While file_name <> "" file_name = Dir() '次のファイル Loop
※Dirはファイル名が返される。
ファイルが見つからない場合には空文字が返る。