[es] - Nestampanje praznih, formula celilija VBA

Karo
G.M.

Član broj: 50566
Poruke: 186
178.237.211.*

+3 Profil

Nestampanje praznih, formula celilija VBA

^{17.01.2021. u 10:24 - pre 65 meseci}

Upitanju je najobicnija popisna lista koja moze da ima 30-300 ili 3000 unosa

ovo radi ali polovicno ostaju nepopunjeni redovi za stampu
Idelano bi bilo da se pomocu VBA selektovane celije koje nemau unos (nevide se) nestamapju

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2290
*.mediaworksit.net.

Sajt: www.gowi.rs

+112 Profil

Re: Nestampanje praznih, formula celilija VBA

^{17.01.2021. u 18:20 - pre 65 meseci}

Kod koji si postavio (nažalost bez primera radne sveske) štampaće samo one redove u kojim u kolini F nije prazna ćelija. (Red ispred PrintOut sakrva redove u kojim je ćelija F prazna, pa ih nakon štampe vraća da budu vidljivi). Eventualni problem je ako u koloni F imaš formule - čak i u slučaju da je rezultat formule prazno "" to se neće smatrati praznom ćelijom. Dakle u tom slučaju treba iskoristiti kolonu u kojoj su zaista prazne ćelije (umesto F) ili promenti uslov da se sakrivaju redovi npr da je tekst u ćeliji dužine nula - vide HideEmpty funkciju u primeru:

Code:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If ActiveSheet.Name = "Sheet1" Then
        Cancel = True
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        On Error Resume Next
        With ActiveSheet
'            .Columns("F").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
             HideEmpty .UsedRange.Columns("F")
            .PrintOut Preview:=True
            UnHideEmpty .UsedRange.Columns("F")
'            .Columns("F").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False
        End With
        On Error GoTo 0
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub
Sub HideEmpty(rng As Range)
    For Each cl In rng.Cells
      If Len(cl.Text) = 0 Then
         cl.EntireRow.Hidden = True
      End If
    Next cl
End Sub

Sub UnHideEmpty(rng As Range)
    For Each cl In rng.Cells
      If Len(cl.Text) = 0 Then
         cl.EntireRow.Hidden = False
      End If
    Next cl
End Sub

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu