VBATools

Dodanie nowego wiersza w tabeli

by on Jun.03, 2011, under Porady, Word

Poniżej przedstawiam krótki kod kopiujący układ oraz format/styl ostatniego wiersza zaznaczonej tabeli Word i na jego podstawie dodający X wierszy na końcu tej tabeli.

W kodzie została użyta funkcja przytaczana przez Cindy do wylistowania numeru zaznaczonej tabeli, ponieważ w MS Word nie ma parametru zwracającego taki indeks.

Private Sub Wstawienie_wierszy_do_zaznaczonej_tabeli()
'MVP OShon from VBATools.pl
Dim Count%, InsertRows%, tbl As Word.Table
If Selection.Information(wdWithInTable) = False Then _
  MsgBox "Nie zaznaczyłeś tabeli", vbExclamation, "VBATools.pl": Exit Sub
InsertRows = InputBox("Podaj ilośc wierszy jaką chcesz wsadzić do tabeli", _
"Wstawianie wierszy do tabeli", 1)
If IsNumeric(InsertRows) = False Then Exit Sub

On Error GoTo blad
Set tbl = Selection.Tables(1)
With ActiveDocument.Tables(GetTableIndex(tbl))
 .Rows(.Rows.Count).Select
 Selection.Copy
End With
While Count < InsertRows
 Selection.Paste
 Count = Count + 1
Wend
Set tbl = Nothing
Exit Sub
blad:
MsgBox Err.Number & " " & Err.Description
End Sub

Function GetTableIndex(tbl As Word.Table) As Long
'Cindy Meister MVP
 Dim rng As Word.Range
 Set rng = tbl.Range
 rng.Start = tbl.Parent.Content.Start
 GetTableIndex = CLng(rng.Tables.Count)
End Function 

Kod nadaje się świetnie do rozszerzenia funkcjonalności formularzy.

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.

:, , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Emil Wasilewski
Profile picture of programistaaccess
Profile picture of Karol Stilger
Profile picture of Anorak
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of piotrpawlik
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of marcinmachalowski
Profile picture of Joanna Subik
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of kicekpicek
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała