Stampa preko makroa na osnovu promenljivog opsega

Stampa preko makroa na osnovu promenljivog opsega 06.11.2018. u 08:51 · pre 97 meseci #1

Pozdrav narode.

Pre neku nedelju sam postavio temu "Selektovanje i kopiranje od prve do zadnje popunjene celije uz....", gde je @bokinet postavio kod koji mi je odradio posao.
Sada sam pokusao da malo modifikujem kod da bi mi stampao ono sto je raniji kod selektovao.
Vidim da sam modifikovani kod tacno selektuje polje za stampu ali ne i da to isto stampa.
Moze li neko ovo ispraviti?.

Code:
Sub MakeCopy4Me()

    Dim iTotalRows As Long
    Dim iRow As Long
    Dim i As Long

    ' Get total number of rows in sheet
    iTotalRows = ActiveSheet.UsedRange.Columns(6).Rows.Count

    ' Go from last row till first row from back which has data in cell
    For i = iTotalRows To 1 Step -1

        If Cells(i, 6).Value <> "" Then

            iRow = i
            Exit For

        End If

    Next

    ' Make a copy of range
    ActiveSheet.Range("B1:G" & iRow).Select
    ActiveSheet.PageSetup.PrintArea = Range("B1:G" & iRow).Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

Potpis

sve ce ovo jednom proci

PRIMER.xlsm21.51k

Re: Stampa preko makroa na osnovu promenljivog opsega 06.11.2018. u 18:21 · pre 97 meseci #2

Predzadnjih red SELECT -> ADDRESS treba da bude

Code:

ActiveSheet.PageSetup.PrintArea = Range("B1:G" & iRow).Address ' .Select

Prikaz celog koda sa korigovanim redom.

Code:

Sub MakeCopy4Me()

    Dim iTotalRows As Long
    Dim iRow As Long
    Dim i As Long

    ' Get total number of rows in sheet
    iTotalRows = ActiveSheet.UsedRange.Columns(6).Rows.Count

    ' Go from last row till first row from back which has data in cell
    For i = iTotalRows To 1 Step -1

        If Cells(i, 6).Value <> "" Then

            iRow = i
            Exit For

        End If

    Next

    ' Make a copy of range
    ActiveSheet.Range("B1:G" & iRow).Select
    ActiveSheet.PageSetup.PrintArea = Range("B1:G" & iRow).Address ' .Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

Re: Stampa preko makroa na osnovu promenljivog opsega 06.11.2018. u 20:27 · pre 97 meseci #3

Boki svaka cast. Hvala ti
Ovo fercera samo tako.

Sad sam pokusao da u jednom Sheetu-u napravim vise BUTTON-a gde bi jedan Button stampao iz SHEET1, drugi iz SHEET2 i tako dalje

Code:
Sub STAMP3()

    Dim iTotalRows As Long
    Dim iRow As Long
    Dim i As Long

    ' Get total number of rows in sheet
    iTotalRows = Sheets("3").UsedRange.Columns(6).Rows.Count

    ' Go from last row till first row from back which has data in cell
    For i = iTotalRows To 1 Step -1

        If Cells(i, 6).Value <> "" Then

            iRow = i
            Exit For

        End If

    Next

    ' Make a copy of range
    Sheets("3").Range("A1:F" & iRow).Select
    Sheets("3").PageSetup.PrintArea = Range("A1:F" & iRow).Address ' .Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

ali odmah pojavljuje DEBUG "Sheets("3").Range("A1:F" & iRow).Select"
Dali je ovo izvidljivo odraditi da nebih ulazio od Sheet-a do Sheet-a ili jos bolje ako je moguce jednim Gumb-om zadati da se svi Shitovi stampaju

Potpis

sve ce ovo jednom proci

Re: Stampa preko makroa na osnovu promenljivog opsega 06.11.2018. u 23:28 · pre 97 meseci #4

Evo primera ako sam dobro razumeo sta je problem.
U primeru Sheet1, Sheet2 i Sheet3 su isti ali mogu biti razliciti po potrebi te tako onda treba i prilagoditi kod.
Ovo je jedno od resenja.
Moze da se pojednostavi i uradi na neki drugi nacin takodje.

Re - PRIMER.xlsm42.9k

Re: Stampa preko makroa na osnovu promenljivog opsega 07.11.2018. u 07:50 · pre 97 meseci #5

ovo zaista radi kada je u pitanju fiksni broj kolona u svim Sheet-ovima.
medjutim kod mene je razlicito od Sheet-a do Sheet-a pa sam se tu pogubio oko prilagodjavanja koda.
bez obzira sto trebam ulaziti iz Sheet-a u Sheet-a, prvi kod koji je postavio @bokinet radi radnju po Sheet-ovima, zhvalan sam mu na tome.

Potpis

sve ce ovo jednom proci

Re: Stampa preko makroa na osnovu promenljivog opsega 07.11.2018. u 16:06 · pre 97 meseci #6

to je primer koda za svaki sheet te tako u zavisnosti od toga treba samo da se odradi taj deo shodno potrebi!
nisam imao uzorke za ostala 2 sheet-a pa sam od prvog napravio uzorak za 2 i 3.
u datom primeru nije potrebno rucno ulaziti iz sheet-a u sheet, vec to kod treba da radi sam.
inace dati kod je jedan od nacina a kao sto sam vec rekao pre postoje i drugi nacini kako to moze da se resi na osnovu datih parametara i uslova (koji nisu dati ovom prilikom).

Re: Stampa preko makroa na osnovu promenljivog opsega 08.11.2018. u 12:47 · pre 97 meseci #7

od sinoc isprobavam razne solucije odnosno izmene koda da bih dobio željeni rezultat ali ne ide.
u Sheet2 dodao sam jos par kolona, pa sam zato i u kodu koji se odnosi na Sheet2 prosirio opseg.
tako isto sam odradio i za Sheet3. evo dole primera da se vidi na sta sam mislio

Potpis

sve ce ovo jednom proci

Re - PRIMER.xlsm42.31k

Re: Stampa preko makroa na osnovu promenljivog opsega 08.11.2018. u 22:34 · pre 97 meseci #8

isplatila se muka. napokon dodjoh do rezultata
iskoristio sam kod "MakeCopy4Me" gde sam samo dodao "Sheets("Sheet3").Select" pre odredjivanja " iTotalRows = " i tako za svaki Sheet
mozda ima i lakse resenje ali ovo je zadovoljavajuce.
hvala ti jos jednom @bokinet

Code:
Sub MakeCopy4Me()

    Dim iTotalRows As Long
    Dim iRow As Long
    Dim i As Long

    ' ovde menjati ime Sheet-a
    Sheets("Sheet3").Select
    ' Get total number of rows in sheet
    iTotalRows = ActiveSheet.UsedRange.Columns(9).Rows.Count

    ' Go from last row till first row from back which has data in cell
    For i = iTotalRows To 1 Step -1

        If Cells(i, 9).Value <> "" Then

            iRow = i
            Exit For

        End If

    Next

    ' Make a copy of range
    ActiveSheet.Range("B1:J" & iRow).Select
    ActiveSheet.PageSetup.PrintArea = Range("B1:J" & iRow).Address ' .Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

End Sub

Potpis

sve ce ovo jednom proci

Re: Stampa preko makroa na osnovu promenljivog opsega 09.11.2018. u 09:44 · pre 97 meseci #9

Niste rekli da je promenljiva vrednost kolona i sl.
U svakom slucaju imali ste primer f-je GetLastRows() u poslednjem primer koji ste mogli da iskoristite kao polaznu osnovu da to odradite na praktican nacin i da istu malo modifikujete.

U nastavku vam dostavljam primer korekcije na osnovu uvida u vas poslednji post.

Ulazne vrednosti su Sheet kao Worksheet objekat, Total Row Column Index i Value Column index.

F-ja na osnovu zadatih vrednosti vraca vrednost poslednje zauzete kolene tj. prve od pozadi.

Code:

Function GetLastRows(ByVal ThisSheet As Excel.Worksheet, ByVal TotalRowsColIndex As Integer, ByVal ValueColIndex As Integer) As Long

    Dim iTotalRows As Long

    ' Return value
    GetLastRows = 0

    With ThisSheet

        ' Get total rows for given column
        iTotalRows = .UsedRange.Columns(TotalRowsColIndex).Rows.Count

        ' Go from last row till first row from back which has data in cell
        For i = iTotalRows To 1 Step -1

            If .Cells(i, ValueColIndex).Value <> "" Then

                ' Return value
                GetLastRows = i
                Exit For

            End If

        Next

    End With

End Function

Primer pozivanja f-je u kod bi bilo nesto kao:

Code:

    Dim sSheetName As String

    sSheetName = "Sheet1"
    iRow = GetLastRows(Excel.Sheets(sSheetName), 9, 9)

'    ili

    iRow = GetLastRows(Excel.Sheets("Sheet1"), 9, 9)

    If iRow = 0 Then

        MsgBox "No rows for given column."
        Exit Sub

    End If

'    ...

Primer koda na osnovu predzadnjeg koda gde je bila data ista f-ja ali bez poslednja 2 ulazna parametra f-je a sada sa dodatim parametrima.

Code:

Sub Print4MeSheet1()

    Dim iTotalRows As Long
    Dim iRow As Long
    Dim i As Long
    Dim sSheetName As String
    Dim sRange As String

    sSheetName = "Sheet1"

    ' Get last row
    iRow = GetLastRows(Excel.Sheets(sSheetName), 6, 6)

    If iRow = 0 Then

        MsgBox "No rows for given column."
        Exit Sub

    End If

    With Excel.Sheets(sSheetName)
        .Activate
        .Select
        .Range("B1:G" & iRow).Select
        sRange = Range("B1:G" & iRow).Address
    End With

    ' Do printing job for me
    Print4Me Excel.Sheets(sSheetName), sRange

End Sub

U prilogu je dat i xls file sa ovim izmenama.

p.s. Sto se same stampe tice treba obratiti na orijentaciju papira kao i na margine.

Re Re - PRIMER.xlsm43.62k

Re: Stampa preko makroa na osnovu promenljivog opsega 12.12.2018. u 23:04 · pre 96 meseci #10

opet problem oko stampe, kod svih Sheet-ova ide lepo stampa ali kod "5" je zapeo. ne prelazi sa selekcijom od 55 reda.
@Bokinet pratio sam tvoj kod i nisam mogao da uocim gresku jer isti sistem kod svih sheet-ova.
u cemu je problem

Potpis

sve ce ovo jednom proci

Book2.xlsm26.57k

Re: Stampa preko makroa na osnovu promenljivog opsega 12.12.2018. u 23:14 · pre 96 meseci #11

verovatno zato sto se gleda kolona br. 19 a mozda recimo bi trebalo kolona 13/14

Code:

Sub Print5()

    Dim iTotalRows As Long
    Dim iRow As Long
    Dim i As Long
    Dim sSheetName As String
    Dim sRange As String

    sSheetName = "5"

    ' Get last row
    'iRow = GetLastRows(Excel.Sheets(sSheetName), 19, 19)
    iRow = GetLastRows(Excel.Sheets(sSheetName), 14, 14)

    With Excel.Sheets(sSheetName)
        .Activate
        .Select
        .Range("D1:V" & iRow).Select
        sRange = Range("D1:V" & iRow).Address
    End With

    ' Do printing job for me
    Print4Me Excel.Sheets(sSheetName), sRange

End Sub

Re: Stampa preko makroa na osnovu promenljivog opsega 12.12.2018. u 23:32 · pre 96 meseci #12

Ja sam razumeo da je 19 iz razloga jer od D do V ima ukupno 19 kolona i iz tog razloga sam ubacio 19. Zbog čega je sad 14 ?

Potpis

sve ce ovo jednom proci

Re: Stampa preko makroa na osnovu promenljivog opsega 12.12.2018. u 23:42 · pre 96 meseci #13

Zato sto je kolona 14 najduza u celom vasem dokumentu a ako se uzima 19 onda je druga (kraca) vrednost i iz tog razloga vam se ne vraca brojac odnosno vrednost od, bese, 80 redova nego manja jer ustvari u koloni br. 19 nema 80 vec manje od 80.

Moze recimo da se napravi dodatna f-ja koja bi prosla kroz sve kolone i trazila koja kolona ima najvise redova i onda vratila vrednost cime bi se recimo izbeglo da se navodi koja se kolona gleda dokle ima vrednosti.
Nesto kao automatsko pretrazivanje celog sheet-a i zakljucivanja u vidu povratne vrednosti kao sto sada vraca f-ja.

Re: Stampa preko makroa na osnovu promenljivog opsega 13.12.2018. u 00:02 · pre 96 meseci #14

Evo te neke varijante da se gledaju sve kolono odnosno definisani opseg OD DO kolona i da se vraca povratna vrednost ustvari koja kolona ima najvise redova.

Izmenjena vas deo koda Print5() koji koristi novu f-ju:

Code:

Sub Print5()

    Dim iTotalRows As Long
    Dim iRow As Long
    Dim i As Long
    Dim sSheetName As String
    Dim sRange As String

    sSheetName = "5"

    ' Get last row
    'iRow = GetLastRows(Excel.Sheets(sSheetName), 19, 19)

    'iRow = GetLastRowsInSheet(Excel.Sheets(sSheetName), 1, 19) ' kada se navodi od koje do koje kolone (dve poslednje vrednosti su opcione i ako se ne stave onda ce biti 1...19)
    iRow = GetLastRowsInSheet(Excel.Sheets(sSheetName)) ' bez navodjenja poslednje 2 vrednosti odnosno koriste se podrazumevane vrednost 1 i 19 ... i gledaju sve kolone od 1 do 19

    With Excel.Sheets(sSheetName)
        .Activate
        .Select
        .Range("D1:V" & iRow).Select
        sRange = Range("D1:V" & iRow).Address
    End With

    ' Do printing job for me
    Print4Me Excel.Sheets(sSheetName), sRange

End Sub

Dodata f-ja:

Code:

Function GetLastRowsInSheet(ByVal ThisSheet As Excel.Worksheet, Optional ByVal FromCol As Integer = 1, Optional ByVal ToCol As Integer = 19) As Long

    Dim i As Integer
    Dim lVal As Long
    Dim r As Long

    r = 0

    For i = FromCol To ToCol

        lVal = GetLastRows(ThisSheet, i, i)

        If lVal > r Then r = lVal

    Next

    GetLastRowsInSheet = r

End Function

Forum kao aplikacija na telefonu

Srodne teme