Страницы: 1
RSS
VBA: не перемещать курсор после закрытия формы ввода
 
Доброго времени суток.
Подскажите что нужно прописать, чтобы после закрытия формы ввода курсор не возвращался в начало таблицы, а оставался на последней строчке.
В форме ввода я ввожу данные в умную таблицу, в которой уже 1300 строк, после добавления записи возвращаюсь на на 1ую.
 
Сначала нужно посмотреть, что прописали Вы. Покажите пример в Excel.
 
Код
Private Sub B_Дата1_Change_Click()
    Me.Date1 = Get_Date(Me.Date1, DateSerial(1980, 1, 1))
End Sub
Private Sub MyBtnAddEntries2_Click()
        Dim nextRow As Long
        Dim iRow As Single
      
  nextRow = MyList2.Cells(MyList2.Rows.Count, 3).End(xlUp).Offset(1, 0).Row
        
        
            Date1Name = Date1.Value
            Name1 = MyItemName1.Value
            Name2 = MyItemName2.Value
            Name3 = MyItemName3.Value
            Name4 = MyItemName4.Value
            Name5 = MyItemName5.Value
            Name6 = MyItemName6.Value
            Name7 = MyItemName7.Value
            Name8 = MyItemName8.Value
                               
                h = Name4 / 1000
                d = (Name6 * Name7 / Name8) / 1000
                c = Name6 * Name7 / Name8
                q = Str(Name4)
                w = Str(Name6)
                e = Str(Name5)
                r = Str(Name7)
                t = Str(Name8)
      
    With MyList2
        On Error Resume Next
         iRow = .ListObjects("MyDataTable2").DataBodyRange.Rows.Count + 2
 
        If Err.Number <> 0 Then
            Err.Clear
            iRow = 2
        Else
            On Error GoTo 0
            'code when there's no error
        End If
        
        If .Range("B2").Value = "" And .Range("C2").Value = "" Then
            nextRow = nextRow - 1
        End If
        
        
            .Cells(iRow, "C").Value = Name1
            .Range("D" & iRow).Value = Name3
            .Range("E" & iRow).Value = q
            .Range("I" & iRow).Value = w
            .Range("J" & iRow).Value = Name2
            .Range("K" & iRow).Value = Date1Name
            .Range("L" & iRow).Value = e
            .Range("N" & iRow).Value = r
            .Range("O" & iRow).Value = t
            .Range("F" & iRow).Value = h
            .Range("G" & iRow).Value = c
            .Range("H" & iRow).Value = d
            
        
            .Range("B2").Formula = "=IF(ISBLANK(C2), """", COUNTA($C$2:C2))"
        
             If nextRow > 2 Then
                 Range("B2").Select
                Selection.AutoFill Destination:=Range("B2:B" & nextRow)
                Range("B2:B" & nextRow).Select
            End If
        
        End With
        
        RemoveDataFromTable
End Sub

Sub RemoveDataFromTable()
        MyItemName6.Value = Empty
        MyItemName2.Value = Empty
        MyItemName5.Value = Empty
        MyItemName1.Text = Empty
        MyItemName3.Value = Empty
        MyItemName4.Value = ""
        
End Sub
Изменено: Simonbest - 13.11.2017 22:06:18
 
Цитата
vikttur написал:
Покажите пример в Excel.
При всём уважении, Simonbest, Вы читать умеете?  :)  
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Извиняюсь,  не прикрепился файл. Вот сейчас пробую
 
Файл - не больше, чем 100Кб ?
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Да, да в этом то и была проблема, еле еле вложился.Спасибо
 
Simonbest, код следует оформлять соответствующим тегом. Ищите такую кнопку и исправьте своё сообщение.
 
Цитата
Юрий М написал:
Simonbest , код следует оформлять соответствующим тегом. Ищите такую кнопку и исправьте своё сообщение.
ок, сделал
 
Уберите это за безнадобностью
Код
'            .Range("B2").Formula = "=IF(ISBLANK(C2), """", COUNTA($C$2:C2))"
'
'             If nextRow > 2 Then
'                 Range("B2").Select
'                Selection.AutoFill Destination:=Range("B2:B" & nextRow)
'                Range("B2:B" & nextRow).Select
'            End If
 
Если это убрать, тогда перестает счетать номер по порядку
Изменено: Simonbest - 14.11.2017 19:24:15
 
Цитата
Simonbest написал:
счетать
может и перестанет, а вставлять будет
 
Допишите в конце(можно перед RemoveDataFromTable):
Код
application.Goto Range("B" & nextRow).address(1,1,xlR1C1,true),true
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
The_Prist написал:
Допишите в конце(можно перед RemoveDataFromTable):Код ? 1application.Goto Range("B" & nextRow).address(1,1,xlR1C1,true),true
Большое спасибо, помогло!!!
Страницы: 1
Наверх