Automatisch toevoegen regels in tabel

[FredvanderLaan2]

Hallo Allemaal,

Ik heb voor een lijst een optie tot het toevoegen van een logbox. Echter wisseld het aantal gemonitoorde signalen waardoor het aantal toe te voegen regels niet altijd een vaste waarde is.\

Wat ik zou willen is dat als ik de waarde in D8 invul en vervolgens Logbox "Yes" selecteer er automatisch het aantal regels onderaan de tabel van blad 2 toegevoegd worden.

Grt.
Fred

 

[gast0660]

Zo?
Code in blad1

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("D7")) Is Nothing Then
Set BL2tabel = Sheets("Blad2").ListObjects(1)
    If [D7].Value = "Yes" Then
        For iCnt = 1 To [D8].Value
            BL2tabel.ListRows.Add
        Next
    Else
    End If
End If
End Sub

 

[Haije]

Of zo? (ook code achter Blad1)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target = [D8] Then
x = [D8]
    With Sheets("Blad2")
        afm = .ListObjects("Tabel1").Range.Address          'haal het bereik van de tabel op
        delen = Split(afm, "$")                                        'splits het bereik in onderdelen
        laatste = --Split(afm, "$")(4)                               'haal de laatse regel op
        nieuw = laatste + x                                             'tel de gewenste waar er bij op
        nwtabel = delen(1) & delen(2) & delen(3) & nieuw 'creeer het nieuwe bereik
        .ListObjects("Tabel1").Resize Range(nwtabel)         'vergroot de tabel
End With
End If
End Sub

 

[FredvanderLaan2]

Optie 1 is de werkende optie in dit geval. Nu stuit ik wel nog op een ander punt. Als de gebruiker meerdere keren op Yes drukt komen er steeds weer 14 nieuwe regels bij. Nu is dat een stukje gebruiker die moet begrijpen wat hij doet maar is het mogelijk om het zo te maken dat hij het maar 1 keer kan doen? Mits het getal verandert bijvoorbeeld?

 

[gast0660]

Zoiets?
Als de code wordt uitgevoerd wordt het woordje klaar in cel D9 gezet.
Zolang er klaar staat in cel D9 wordt de code niet meer uitgevoerd.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("D7")) Is Nothing Then
Set BL2tabel = Sheets("Blad2").ListObjects(1)
    If [D7].Value = "Yes" And [D9].Value <> "klaar" Then
        For iCnt = 1 To [D8].Value
            BL2tabel.ListRows.Add
        Next
    [D9].Value = "klaar"
    Else
    End If
End If
End Sub

 

[Haije]

Deze aangepaste optie 2 reageert niet op Yes of No, maar op de inhoud van D8

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target = [D8] Then
x = [D8]
    With Sheets("Blad2")
        afm = .ListObjects("Tabel1").Range.Address          'haal het bereik van de tabel op
        delen = Split(afm, "$")                                        'splits het bereik in onderdelen
        laatste = --Split(afm, "$")(4)                               'haal de laatse regel op
        nieuw = laatste + x                                             'tel de gewenste waar er bij op
        nwtabel = delen(1) & delen(2) & delen(3) & nieuw 'creeer het nieuwe bereik
        .ListObjects("Tabel1").Resize Range(nwtabel)         'vergroot de tabel
End With
[COLOR="#FF0000"][D8].ClearContents[/COLOR]
End If
End Sub

 

[sylvester-ponte]

of deze:

 

[cow18]

ik vond die optie van Haije en sylverster-ponte heel goed, maar tijdens het proberen viel me op dat, in geval er iets stond onder je list, bv. 2 rijen er onder en je voegt 3 rijen toe, die zaken niet naar beneden geschoven worden zoals bij een listrow.add maar mee opgenomen in de nieuwe listrows.
Dus daar moet vooraf op geschikt worden of er moet vooraf voorzorgen genomen worden.

kladversie

Sub test()
   x = [D8]
   With ActiveSheet
      With .ListObjects(1)
         'headerrowrange voor het geval er 0 listrows zijn !!!
         .HeaderRowRange.Offset(.ListRows.Count + 1).Resize(x).Insert xlDown   'gebied vrijmaken
         .Resize .HeaderRowRange.Resize(.ListRows.Count + 1 + x)   'vergroot de tabel
      End With
   End With
   [D8].ClearContents
End Sub