Hallo,
Merk op dat je zelf geen totaalrij moet gaan knutselen in een tabel. Dat is een optie die je kan aanvinken als de tabel geselecteerd wordt.
Totalen hoeven ook niet gewoon een som te zijn, kan ook een gemiddelde zijn, aantal, ...
Ik zou gaan voor deze mooie oplossing.
Zet die in de code van het blad waar de tabel zich bevindt:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
VoegLijnAanTabelToe Target, 3
End Sub
In een standaard module zet je deze code:
Code:
Sub VoegLijnAanTabelToe(r As Range, Optional iChoiceOfColumn As Integer = 3)
Dim lo As ListObject
Dim sTableName As String
Dim oNewRow As ListRow
Dim rng As Range
Dim i As Long
''the selection cannot be inside a table
''if not, just clicking a table cell would always add rows
On Error Resume Next
sTableName = r.Cells(1).ListObject.Name
On Error GoTo 0
If Len(sTableName) > 0 Then
Exit Sub
End If
''look for a table that matches the selection
For Each lo In r.Parent.ListObjects
On Error Resume Next
sTableName = r.Cells(1).Offset(-1).ListObject.Name
On Error GoTo 0
If Len(sTableName) > 0 Then
''we found a table, now insert row(s)
For i = 1 To r.Rows.Count
Set oNewRow = lo.ListRows.Add(AlwaysInsert:=True)
If i = 1 Then Set rng = oNewRow.Range
Next
''select a cell in the first of the new rows
'we can:
'1. go to the first column of the table
'2. stay in the same column as where the user clicked
'3. go to the first column that is blank (if not found, option 1 is chosen instead)
Application.EnableEvents = False
Select Case iChoiceOfColumn
Case 1: 'go to the first column of the table
Application.Intersect(rng, lo.DataBodyRange.Columns(1)).Select
Case 2: 'stay in the same column as where the user clicked
Application.Intersect(rng, r.Parent.Columns(r.Column)).Select
Case 3: 'go to the first column that is not a cell with a formula (if not found, option 1 is chosen)
On Error Resume Next
rng.SpecialCells(xlCellTypeBlanks).Cells(1).Select
If Err.Number Then
Err.Clear
Application.Intersect(rng, lo.DataBodyRange.Columns(1)).Select
End If
On Error GoTo 0
End Select
Application.EnableEvents = True
Exit For
End If
Next
End Sub
Ik heb deze code net geschreven en zal er dit weekend of volgende week een artikel aan wijden op mijn website.
Kort gezegd, selecteer (klik aan) een cel onder de tabel (zonder een rij tussen te laten) en de tabel breidt automatisch uit en zet de selectie goed in die nieuwe rij.
Selecteer je een bereik van 10 cellen onder mekaar, net onder de tabel, dan worden ineens 10 nieuwe rijen ingevoegd.
Loop eens door de code en je zal zien dat je ook kan kiezen (die ,3 in de aanroep van de procedure) in welke kolom van de (eerste) nieuwe rij je automatisch terecht wil komen.
- waarde 1 laat je terecht komen in de eerste kolom van de tabel, of die cel nu leeg is of niet
- waarde 2 laat je terecht komen in dezelfde kolom van de tabel als waar je de cel aanklikte onder de tabel
- waarde 3 laat je terecht komen in de eerste lege kolom van de (eerste) nieuwe rij
- als je 3 kiest maar er is geen vrije cel, dan geldt toch optie 1
Experimenteer er eens goed mee, dit is good stuff ;-)
Wim
