Word - usuwanie wierszy z tabel

[Speedy]

Hej

Wrzuciłem to na grupę o office.xp ale w sumie tu chyba będzie lepsze miejsce
bo problem dotyczy VBA. Dopiero się go uczę i cięzko mi to idzie, a problem
wydaje się prosty więc może ktoś mi podpowie rozwiązanie?

Jest sobie duży dokument, zawierający wielką liczbę jednakowych tabel, od
małych kilkuwierszowych po takie na kilkadziesiąt stron. Wszystkie tabele są
takie same (ściślej biorąc na początku jest kilka odmiennych ale ich ta
sprawa nie dotyczy). Mają 7 kolumn (w nagłówku 6 bo dwie kolumny, 3. i 4.
mają nad sobą jedną komórkę w nagłówku). Interesująca jest dla mnie kolumna
6-ta (5-ta w nagłówku). W jej komórkach może być albo literka B albo nic
(pusta komórka). Trzeba przeszukać wiersze we wszystkich tabelach i dla
każdego sprawdzić zawartość komórki w tej kolumnie. Jeśli jest wypęlniona
(jest tam B) - OK, tak ma być, wszystko zostaje bez zmian. Jeśli jest
pusta - taki wiersz należy usunąć z tabeli.
Jak mam to zrobić? Wymysliłem sobie takiego stwora, ale nie za strasznie mi
to chce działać:

Sub betki()
liczTab = ActiveDocument.Tables.Count
'to zrobilem po to by moc policzyc wiersze w kazdej tabeli
For i = 1 To liczTab
liczRow = ActiveDocument.Tables(i).Rows.Count - 2
'a to po to by móc zaadresować komórkę numerem wiersza i kolumny, minus
nagłówek ktory w pewnym miejscu jest na 2 wiersze
For j = 3 To liczRow
Set klapka = ActiveDocument.Tables(i).Cell(j, 6).Range
klapka.MoveEnd Unit:=wdCharacter, Count:=-1
'nie wiem czy to jest potrzebne, chodzi o to by sie cofnac o 1 znak w tej
komorce bo tam jest tylko 1 znak
'MsgBox klapka.Text
' tu wstawiałem msgboxa żeby mi pokazał co właœciwie za tekst znajduje.
Powinien wyjsc pusty lub z literkš B (taka jest zawartosc tej kolumny) ale
nie zawsze _ jest, czasami jakby pokazywal zawartosc sasiedniej komórki lub
2 komorek naraz, najwyrazniej nie umiem tego poprawnie zaadresowac
If klapka.Text <> "^#" Then
'tak sobie wymyslilem znalezienie pustej komorki
ActiveDocument.Tables(i).Cell(j, 6).Select
Selection.Rows.Delete
End If
Next
Next
End Sub

Po uruchomieniu owszem znajduje puste wiersze w tabeli i kasuje je (są tam
wstawione przez kogoś "żeby ładnie wyglądało", no i dobrze, ich też mógłbym
się pozbyć przy okazji), i kasuje też niektóre wiersze które powinien (te
które mają pustą komórkę w tej kolumnie) ale niekóre takie zostawia , a
także kasuje niektóre takie które powinny zostać (które majš wypełnioną
komórkę w wyznaczonej kolumnie). W ogóle jak puściłem krok po kroku to
wygląda że nie kończy działania z końcem tabeli, nie wiem czemu. Zdaje się
że nawywijałem za bardzo...:(

[Skylla]

Na pewno wiersze musisz przeglądać od końca tabeli, bo inaczej nie zgadzają się
warunki pętli po usunięciu choćby jednego z nich.

[Skylla]

Post by Skylla
Na pewno wiersze musisz przeglądać od końca tabeli, bo inaczej nie zgadzają
się warunki pętli po usunięciu choćby jednego z nich.

Na szybko napisany kod dla jednej tabeli - sprawdza pierwszą komórkę w wierszu:

Sub UsunPusteWiersze()
Dim nw As Long, i As Long

nw = ActiveDocument.Tables(1).Rows.Count
For i = nw To 1 Step -1
If ActiveDocument.Tables(1).Cell(i, 1).Range.Text = Chr(13) & Chr(7) Then
ActiveDocument.Tables(1).Rows(i).Delete
End If
Next
End Sub

[Speedy]

Hej

Post by Skylla

Post by Skylla
Na pewno wiersze musisz przeglądać od końca tabeli, bo inaczej nie
zgadzają się warunki pętli po usunięciu choćby jednego z nich.

Sub UsunPusteWiersze()
Dim nw As Long, i As Long
nw = ActiveDocument.Tables(1).Rows.Count
For i = nw To 1 Step -1
If ActiveDocument.Tables(1).Cell(i, 1).Range.Text = Chr(13) & Chr(7) Then
ActiveDocument.Tables(1).Rows(i).Delete
End If
Next
End Sub

Dzięki wielkie!! działa !! Muszę się po prostu nauczyć myśleć w innych
kierunkach, :) ta pętla do tyłu przerosła mnie ewidentnie... a tego Chr(13)
& Chr(7) to przyznam uczciwie że nie rozumiem, nie uczyli mnie tego i
pierwszy raz widzę - w każdym razie wykrywa mi puste tak jak trzeba, a to
najwazniejsze.

W efekcie zrobiłem coś takiego:

Sub betki()
liczTab = ActiveDocument.Tables.Count
For i = 1 To liczTab
liczRow = ActiveDocument.Tables(i).Rows.Count - 2
For j = liczRow To 3 Step -1
If ActiveDocument.Tables(i).Cell(j, 6).Range.Text = Chr(13) & Chr(7) Then
ActiveDocument.Tables(i).Rows(j).Delete
End If
Next
Next
End Sub

Dzięki jeszcze raz!!!