Ispravka koda za insert row

Ispravka koda za insert row 12.12.2020. u 22:33 · pre 71 mesec #1

Pozdrav
Trebala bi mi dopuna ili ispravka koda,naravno ako ima voljni da pogledaju.
-------------------------------------------
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False

If EntireRow.Row() < 38 Then

MsgBox "LIMIT"
Exit Sub

Else
End If

Dim lHiddenRws As Long
On Error Resume Next

With Cells.SpecialCells(xlCellTypeVisible)
lHiddenRws = .Areas(1).Rows.Count + 1
.Areas(1)(lHiddenRws, 1).EntireRow.Hidden = False

End With
End Sub
---------------------------------------------------------
Donji kod otkriva sakrivene retke,stavio sam if ako dodje do retka 39 da izbaci poruku i trebao mi da izadje iz koda a ako ne da otkrije red,ali ne funkcionise.
Ako neko moze da ispravi kod,unaprijed hvala.

Potpis

Jasmin

Re: Ispravka koda za insert row 12.12.2020. u 22:54 · pre 71 mesec #2

Ne razumem šta sve taj tvoj program treba da uradi ali evo ti code za otkrivanje skrivenih redova

Code:

Sub OtkrijSkriveneRedove()
    Dim i as Long
    For i = 1 To 38
       If Rows(i).EntireRow.Hidden = True Then Rows(i).EntireRow.Hidden = False
    Next i
End Sub

Re: Ispravka koda za insert row 13.12.2020. u 17:04 · pre 71 mesec #3

Pozdrav
Hvala na javljanju.
Ovako donji dio koda otkriva jedan red,to vec imam,ali sam stavio ovaj kod ispred da prije nego sto otkrije red
da provjeri ako dodje do reda broj 38 ( u ovom slucaju,jer sam stavio data validation do tog reda) da izbaci poruku i exit iz koda, ako ne da da otkrije sljedeci red to vec imam.
Kad ubacim ovaj kod ispred prikazuje greske.
If EntireRow.Row() < 38 Then

MsgBox "LIMIT"
Exit Sub

Else
End If
------------------------------------------------------------
ovaj dio samostalno radi a kad ubacim gornji kod, da izvrsi provjeru izbacuje gresku

Dim lHiddenRws As Long
On Error Resume Next

With Cells.SpecialCells(xlCellTypeVisible)
lHiddenRws = .Areas(1).Rows.Count + 1
.Areas(1)(lHiddenRws, 1).EntireRow.Hidden = False

-------------------------------------------------------
hvala unaprijed

Potpis

Jasmin

Re: Ispravka koda za insert row 13.12.2020. u 20:58 · pre 71 mesec #4

Range.EntireRow property (Excel)
docs.microsoft.com/en-us/office/vba/api/excel.range.entirerow

Re: Ispravka koda za insert row 13.12.2020. u 22:12 · pre 71 mesec #5

Vidi može li ti ovo pomoći

Code:
'Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lHiddenRws As Long
Dim LastRow As Integer
Dim x As Integer

Application.ScreenUpdating = False

    'find last row
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
       x = LastRow

    'count visible rows
    RowCount = Range("A1:A" & x).Rows.SpecialCells(xlCellTypeVisible).Count
       r = RowCount

        'kada vba izbroji 38 vidljivih redova od A1 do A38
        If r = 38 Then
            MsgBox "LIMIT Rows = " & r
            Exit Sub
            Else
        End If

     'svaka promjena na sheetu otkriva jedan red počevši od A1
            With Cells.SpecialCells(xlCellTypeVisible)
                lHiddenRws = .Areas(1).Rows.Count + 1
                .Areas(1)(lHiddenRws, 1).EntireRow.Hidden = False
            End With
Application.ScreenUpdating = True
End Sub

Re: Ispravka koda za insert row 14.12.2020. u 15:33 · pre 71 mesec #6

Pozdrav
Hvala Ivek,radi bas kako treba-
lp

Potpis

Jasmin

Forum kao aplikacija na telefonu

Srodne teme