差分

このページの2つのバージョン間の差分を表示します。

この比較画面へのリンク

両方とも前のリビジョン前のリビジョン
playground:playground [2025/02/06 01:20] bananaplayground:playground [2025/02/06 01:29] (現在) banana
行 1: 行 1:
 ====== PlayGround ====== ====== PlayGround ======
-<code> 
-Attribute VB_Name = "Module1" 
-Option Explicit 
-Private Sub ShowSchedule() 
- Worksheets(2).Select 
-End Sub 
-Private Sub NewWeek() 
  
-    Dim lngCopyDetails As Long 
-     
-    Const EDITABLE_GRID_ROWS = 96 
-    Const EDITABLE_GRID_COLS = 21 
-    Const EDITABLE_GRID_OFFSET_ROW = 1 
-    Const EDITABLE_GRID_OFFSET_COL = 2 
-    Const DAYS_IN_WEEK = 7 
-    Const SELECT_ROW = 2 
-    Const SELECT_COL = 4 
-     
-    On Error Resume Next 
-     
-    lngCopyDetails = MsgBox("この週の詳細内容を新しいスケジュールにコピーしますか?", vbYesNoCancel, "詳細をコピーしますか?") 
-    If lngCopyDetails = vbCancel Then Exit Sub 
-     
-    With Application 
-        .ScreenUpdating = False 
-        .DisplayAlerts = False 
-        ActiveSheet.Copy before:=ActiveSheet 
-        With ActiveSheet.Range("WeekStartDate") 
-            .Value = .Value + DAYS_IN_WEEK 
-            .Parent.Name = Format(.Value, "m 月 d 日 ;@") 
-            .Offset(SELECT_ROW, SELECT_COL).Select 
-            If vbNo = lngCopyDetails Then 
-                .Offset(EDITABLE_GRID_OFFSET_ROW, _ 
-                        EDITABLE_GRID_OFFSET_COL).Resize(EDITABLE_GRID_ROWS, _ 
-                                                         EDITABLE_GRID_COLS).ClearContents 
-            End If 
-        End With 
-        .DisplayAlerts = True 
-        .ScreenUpdating = True 
-    End With 
-     
-End Sub 
-Private Sub Worksheet_Change(ByVal Target As Range) 
- 
-    On Error Resume Next 
-    If Target.Cells.Count > 1 Then Exit Sub 
-    If Not Intersect(Target, [WeekStartDate]) Is Nothing Then 
-        [WeekStartDate].Worksheet.Name = Format([WeekStartDate], "m 月 d 日 ;@") 
-    End If 
- 
-End Sub 
- 
-Public Sub CellRoundRobin(rTarget As Range, rValidRange As Range, Cancel As Boolean) 
- 
-    On Error Resume Next 
-     
-    If rTarget.Cells.Count > 1 Then Exit Sub 
-    If Intersect(rTarget, rValidRange) Is Nothing Then Exit Sub 
-    If Len(rTarget.Offset(, 2)) = 0 Then Exit Sub 
-     
-    If Len(rTarget) Then 
-        rTarget = vbNullString 
-    Else 
-        rTarget = 1 
-    End If 
-     
-    Cancel = True 
- 
-End Sub 
-</code> 
  

QR Code
QR Code playground:playground (generated for current page)