Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

Stampa preko makroa na osnovu promenljivog opsega

[es] :: Office :: Excel :: Stampa preko makroa na osnovu promenljivog opsega

[ Pregleda: 1401 | Odgovora: 13 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.static.isp.telekom.rs.



+1 Profil

icon Stampa preko makroa na osnovu promenljivog opsega06.11.2018. u 07:51 - pre 65 meseci
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

sve ce ovo jednom proci
Prikačeni fajlovi
 
Odgovor na temu

bokinet

Član broj: 29844
Poruke: 574



+50 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega06.11.2018. u 17:21 - pre 65 meseci

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


 
Odgovor na temu

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.dynamic.isp.telekom.rs.



+1 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega06.11.2018. u 19:27 - pre 65 meseci
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
sve ce ovo jednom proci
 
Odgovor na temu

bokinet

Član broj: 29844
Poruke: 574



+50 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega06.11.2018. u 22:28 - pre 65 meseci
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.
Prikačeni fajlovi
 
Odgovor na temu

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.static.isp.telekom.rs.



+1 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega07.11.2018. u 06:50 - pre 65 meseci
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.

sve ce ovo jednom proci
 
Odgovor na temu

bokinet

Član broj: 29844
Poruke: 574



+50 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega07.11.2018. u 15:06 - pre 65 meseci
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).
 
Odgovor na temu

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.static.isp.telekom.rs.



+1 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega08.11.2018. u 11:47 - pre 65 meseci
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
sve ce ovo jednom proci
Prikačeni fajlovi
 
Odgovor na temu

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.dynamic.isp.telekom.rs.



+1 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega08.11.2018. u 21:34 - pre 65 meseci
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


sve ce ovo jednom proci
 
Odgovor na temu

bokinet

Član broj: 29844
Poruke: 574



+50 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega09.11.2018. u 08:44 - pre 65 meseci
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.



Prikačeni fajlovi
 
Odgovor na temu

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.dynamic.isp.telekom.rs.



+1 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega12.12.2018. u 22:04 - pre 64 meseci
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
sve ce ovo jednom proci
Prikačeni fajlovi
 
Odgovor na temu

bokinet

Član broj: 29844
Poruke: 574



+50 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega12.12.2018. u 22:14 - pre 64 meseci
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



 
Odgovor na temu

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.dynamic.isp.telekom.rs.



+1 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega12.12.2018. u 22:32 - pre 64 meseci
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 ?
sve ce ovo jednom proci
 
Odgovor na temu

bokinet

Član broj: 29844
Poruke: 574



+50 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega12.12.2018. u 22:42 - pre 64 meseci
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.



 
Odgovor na temu

bokinet

Član broj: 29844
Poruke: 574



+50 Profil

icon Re: Stampa preko makroa na osnovu promenljivog opsega12.12.2018. u 23:02 - pre 64 meseci
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

 
Odgovor na temu

[es] :: Office :: Excel :: Stampa preko makroa na osnovu promenljivog opsega

[ Pregleda: 1401 | Odgovora: 13 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.