Кнопки на VBA не соответствуют правильной информации в течение ~ 20 минут - PullRequest
0 голосов
/ 29 декабря 2018

У меня проблемы с VBA, я надеюсь, что кто-то может помочь.

Текущие данные, настроенные в Excel, представляют собой нечто вроде формы.

Нажмите кнопку «Закончено» |Копировать фамилию |Фамилия

Копировать номер ПМ |Номер ПМ |Копировать Скидки |Специальные предложения

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

Моя проблема возникает в течение первых ~ 20 минут после выполнения кода. Кажется, что все кнопки относятся только к первому экземпляру.Т.е. третий 'набор' или строки / третий экземпляр ссылаются на ячейки значений для первого экземпляра.Волшебным образом, примерно через 20 минут все кнопки, кажется, ссылаются на правильную информацию.

Может кто-нибудь сказать мне, что вызывает задержку?Как я могу это исправить?

'Create 'Copy Last Name' button

Sub copyLastName(length As Integer, col As Integer)

    Dim doneButton As Button, t As Range, temp As String

    Set t = Range(Cells(length, col), Cells(length, col))

    Set doneButton = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)

    With doneButton

        .OnAction = "copyNextCell"

        .Caption = "Last Name"

        .name = "Last Name"

    End With

End Sub


'Create 'Copy PM #' button

Sub copyPM(length As Integer, col As Integer)

    Dim doneButton As Button, t As Range, temp As String

    Set t = Range(Cells(length, col), Cells(length, col))

    Set doneButton = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)

    With doneButton

        .OnAction = "copyNextCell"

        .Caption = "CRS #"

        .name = "CRS #"

    End With

End Sub


'Create 'Copy Specials' button

Sub copySpecials(length As Integer, col As Integer)

    Dim doneButton As Button, t As Range, temp As String

    Set t = Range(Cells(length, col), Cells(length, col))

    Set doneButton = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)

    With doneButton

        .OnAction = "copyCellBelow"

        .Caption = "Specials"

        .name = "Specials"

    End With

End Sub

'copy 'Copy Specials' instructions > copy value of cell below to clipboard

Sub copyCellBelow()

    Dim btnName As String, rowNum As Integer

    Set b = ActiveSheet.Buttons(Application.Caller)

    With b.TopLeftCell

        rowNum = .row

    End With

    rowNum = rowNum + 1

    ActiveSheet.Range(Cells(rowNum, 8), Cells(rowNum, 8)).Copy

End Sub


'Add a reference to "Microsoft Forms 2.0 Object Library"

'copy 'PM Conf #' / 'Copy Last Name' instructions > copy value of cell to the right to clipboard

Sub copyNextCell()

    Dim btnName As String, rowNum As Integer

    Set b = ActiveSheet.Buttons(Application.Caller)

    With b.TopLeftCell

        rowNum = .row

    End With

    ActiveSheet.Range(Cells(rowNum, 4), Cells(rowNum, 4)).Copy

End Sub


'Create Done button

Sub greyResButton(length As Integer, col As Integer)

    Dim doneButton As Button, t As Range, temp As String

    Set t = Range(Cells(length, col), Cells(length + 1, col))

    Set doneButton = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)

    With doneButton

        .OnAction = "greyDoneButton"

        .Caption = "Done"

        .name = "Done"

    End With

End Sub


'Done button instructions > grey out row

Sub greyDoneButton()

    Dim btnName As String, rowNum As Integer

    Set b = ActiveSheet.Buttons(Application.Caller)

    With b.TopLeftCell

        rowNum = .row

    End With

    Cells(rowNum, 3).Interior.ColorIndex = 15

    Cells(rowNum + 1, 3).Interior.ColorIndex = 15

    Cells(rowNum, 4).Interior.ColorIndex = 15

    Cells(rowNum + 1, 4).Interior.ColorIndex = 15

    Cells(rowNum, 5).Interior.ColorIndex = 15

    Cells(rowNum + 1, 5).Interior.ColorIndex = 15

    Cells(rowNum, 7).Interior.ColorIndex = 15

    Cells(rowNum + 1, 7).Interior.ColorIndex = 15

    Cells(rowNum + 1, 8).Interior.ColorIndex = 15

    Cells(rowNum, 9).Interior.ColorIndex = 15

    Cells(rowNum, 10).Interior.ColorIndex = 15

    Cells(rowNum, 11).Interior.ColorIndex = 15

    Cells(rowNum, 12).Interior.ColorIndex = 15

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...