Excel VBA: Как предотвратить убийство в пользовательской строке состояния Копирование / вставка - PullRequest
0 голосов
/ 17 января 2020

Я нашел некоторый код, чтобы возиться со строкой состояния, и мне удалось заставить его работать из пользовательского надстройки, но в процессе я случайно остановил копирование и вставку из работы!

Всякий раз, когда я изменяю выделение, оно теряет выделение «Скопировано», поэтому вставлять нечего.

У меня вопрос ... как предотвратить вмешательство приведенного ниже кода в текущий выбор?

Edit1: добавлено в коде функции ссылки

ThisWorkbook

Private WithEvents App As Application

Private Sub Workbook_Open()
    Set App = Application
End Sub

Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call cellLengthStatusBar
End Sub

Код модуля

Option Base 1

Public rngTarget As Range
Public cellLength As Long

Public Sub cellLengthStatusBar()

Dim dim1 As Long, dim2 As Long
Application.DisplayStatusBar = True
Set rngTarget = columnSelectionToRange(Selection)
If rngTarget.Rows.Count > 1 Or rngTarget.Columns.Count > 1 Then
    For dim1 = 1 To rngTarget.Rows.Count
        For dim2 = 1 To rngTarget.Columns.Count
            If Len(rngTarget(dim1, dim2)) > cellLength Then _
                cellLength = Len(rngTarget(dim1, dim2))
        Next dim2
    Next dim1
    Application.statusBar = "MAX CELL LEN: " & cellLength
Else
    Application.statusBar = "CELL LEN: " & Len(rngTarget)
End If
End Sub

Функциональный модуль

Public Function columnSelectionToRange(Target As Range) As Range
    Dim firstRow As Long, lastRow As Long
    On Error GoTo fail
    firstRow = Target.Row
    If Target.Address = Target.EntireColumn.Address Then
        firstRow = Target.Row + 1
        lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, Target.Column).End(xlUp).Row
    Else: lastRow = Target.Rows.Count + firstRow - 1
    End If
    Set columnSelectionToRange = ActiveSheet.Range(Cells(firstRow, Target.Column), Cells(lastRow, Target.Column + Target.Columns.Count - 1))
    'Debug.Print columnSelectionToRange.Address
fail:
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...