Як створити графік проекту за допомогою програми “Натисніть і перетягніть” в Excel

Поділитися зараз:

Наступна стаття показує, як розмітити календар і допитати його за допомогою миша. Розмітьте і допитуйте календар за допомогою миші

* У реальному світі ми відкривали б форму для читання та запису значущих записів щоденника до бази даних. Ця вправа просто розкриває механіку клацання правою кнопкою миші та знаходить деталі з самого аркуша.

Перш ніж розпочати, кілька слів пояснень щодо електронної таблиці, робочу модель якої можна знайти тут.Кілька слів, що пояснюють електронну таблицю

процес

Натискання клітинки в сітці виділить цю клітинку та змінить її значення. Клацання та перетягування виділить діапазон та змінить його значення. Якщо клітинка заповнена, вона буде очищена, інакше вона буде заповнена, у цьому випадку знаком «*».

Клацніть правою кнопкою миші на відміну - це запит на інформацію із вибраної комірки.

По суті, використовуються дві події разом із декількома модулями.

  • Worksheet_SelectionChange що викликається при виборі комірки або комірок.
  • Worksheet_BeforeRightClick що викликається правою кнопкою миші.

Проблема

Клацання правою кнопкою клітинки також являє собою виділення, ініціювання SelectionChange. Нам доведеться дозволити цій події пройти курс, очистивши вибрану клітинку, перш ніж вона здасть контроль Перед RightClick подія, коли ми повторно заселимо очищену клітинку. Але ця дія спровокує ВибірЗмінено події, яку потрібно зупинити, щоб її ще раз не очистили.

Це ми зробимо з логічним прапором під назвою blnLoading.

Події

Введіть наступне у вікно коду за аркушем (тобто не в модулі).

Option Explicit

    Dim blnLoading As Boolean
    Dim sPhase As String
    Dim currCellValue As String
    Dim dDate As Date

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     If ActiveCell.Row > 14 And ActiveCell.Row < 25 Then
         If ActiveCell.Column > 4 And ActiveCell.Column < 47 Then 'selection is valid
 
             On Error Resume Next
             currCellValue = Target.Value 'get the target value from (ByVal Target As Range)
 
             If blnLoading = True Then 'a value of True will force an exit from this event
                 blnLoading = False
                 Exit Sub
             End If
 
             sPhase = Cells(ActiveCell.Row, 1)
             If sPhase = "" Then Exit Sub
 
             If ActiveCell = "*" Then 'if the cell is populated, clear the selected range
                 Call ClearRange
                 Call UnblockCalendar
             Else
                 Call PopulateRange
             End If
 
             Call RedrawCells
             Range("A1").Select 'revive the SelectionChange event by changing selection.
             Exit Sub
         End If
     End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     If currCellValue = "*" Then   'picked up by the previous event BEFORE it cleared it;
                                     'This means this is a valid diary entry with detail.
        blnLoading = True    'this will prevent the SelectionChange event (above) from running.
        Target.Select
        'currCell = Target.Address
        'Range(currCell).Select

            Target.Value = "*" 're-instate the value of the cell, since SelectionChange has cleared it
            Call PopulateRange
            dDate = Cells(13, ActiveCell.Column)
            sPhase = Cells(ActiveCell.Row, 1)
            MsgBox dDate & " - " & sPhase
        Cancel = True 'suppress Excel’s standard right_click menus
    End If
    Range("A1").Select
        blnLoading = False
End Sub

Це піклується про дві події.

Код, на який посилаються

Додайте до коду наступні діапазони заповнення та депопуляції:

Sub ClearRange()
     Selection.FormulaR1C1 = ""
     With Selection.Interior
         .Pattern = xlNone
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

Sub PopulateRange()
     Selection.FormulaR1C1 = "*"
     With Selection.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .ThemeColor = xlThemeColorLight2
         .TintAndShade = 0.799981688894314
         .PatternTintAndShade = 0
     End With
End Sub

Технічне обслуговування ліній електропередач

Вставте модуль у додаток. Додайте наступний код для підтримки вигляду сітки. Це було скопійовано з макрореєстратора, надмірностей та всього іншого.

Option Explicit

Sub UnblockCalendar()
     Selection.FormulaR1C1 = ""
     With Selection
         Selection.Borders(xlDiagonalDown).LineStyle = xlNone
         Selection.Borders(xlDiagonalUp).LineStyle = xlNone
         Selection.Borders(xlEdgeLeft).LineStyle = xlNone
         Selection.Borders(xlEdgeTop).LineStyle = xlNone
         Selection.Borders(xlEdgeBottom).LineStyle = xlNone
         Selection.Borders(xlEdgeRight).LineStyle = xlNone
         Selection.Borders(xlInsideVertical).LineStyle = xlNone
         Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
     End With
End Sub

Sub RedrawCells()
     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
     With Selection.Borders(xlEdgeLeft)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlEdgeTop)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlEdgeBottom)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlEdgeRight)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlInsideVertical)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlInsideHorizontal)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
End Sub

Захист від катастрофи

Кожен, хто багато займається розробкою в Excel, знає, що складні таблиці xlsm можуть час від часу аварійно завершувати роботу, пошкоджуючи відкритий документ. У більшості випадків, ніж можна було б очікувати, пошкоджену книгу неможливо відновити за допомогою процедур відновлення Excel. Якщо немає резервних копій, виконана робота втрачається. Цьому можна запобігти за допомогою інструментів, розроблених для виконання... Виправлення в Excel.

Вступ автора:

Фелікс Хукер - фахівець з відновлення даних у DataNumen, Inc., яка є світовим лідером у галузі технологій відновлення даних, в тому числі ремонт rar-файлів та програмні продукти для відновлення sql. Для отримання додаткової інформації відвідайте WWW.datanumen.com

Поділитися зараз:

Коментарі закриті.