Da li list (treći korak) šalješ primateljima formiraš jedan po jedan - ili za sve primatelje odjednom?
1/ Izbor primatelja
Ako formiraš jedan po jedan list potrebno je na neki način izabrati primatelja za koga se list formira. To može da se uradi tako što ćeš zahtevati od korisnika da unese ili selektuje ćeliju sa nazivom primatelja nakon startovanja makroa:
Code:
Prim = Application.InputBox( prompt:="Selektuj naziv primatelja" )
Prim je ovde promnljiva tipa string. Na sličan način možeš regulisati i druge podatke koje je potrebno uneti (datum, ...) da se formira list koj šalješ.
2/ Određivanje opsega redova u kojem se nalaze podaci
Za zadatog primatelja određuje se opseg redova na listu shPodaci u kome se nalaze podaci startRow do stopRow
Code:
Set shPodaci = ThisWorkbook.Sheets("Lista").
stopRow = shPodaci.Range("A65536").End(xlUp).Row ' Kraj liste
startRow = shPodaci.Columns("A").Find(Prim, _
LookIn:=xlValues, lookat:=xlWhole).Row
For rw = startRow + 1 To stopRow
If shPodaci.Cells(rw, 1).Text <> Prim Then
stopRow = rw - 1
Exit For
End If
Next rw
2/ Otvaranje šablona za slanje
Za formiranje lista koja šalješ čini mi se najlakše da napraviš posebnu radnu svesku koja će sadržati Logotip, naslov (?), odgovarajuće širine kolona - bez konkretnih podatak koje treba popuniti. Ova radna sveska poslužiće kao šablon za formiranje konkretnog lista za primaoca. Za otvaranje radne sveske koristiš metodu Open:
Code:
Set wbk = Workbooks.Open (filename:= ActiveWorkbook.Path & "\SlanjeEmpty.XLS", ReadOnly:=True)
Set shSlanje = wbk.Sheets(1)
Za filename treba da se zada kompletna putanja do radne sveske. U ovom slučaju ja sam pretpostavio da je u istoj fascikli kao i radna sveska u kojoj se makro nalazi. Radnu svesku otvaraš kao readonly jer ćeš je kasnije snimiti pod drugim imenom, a original uvek ostaje prazan. List sa kojim radimo pretpostavio sam da je 1.
3/ Upis podataka u radnu svesku primatelja
Za upis podataka referišeš se na odgovarajuću ćeliju šablona, lista shSlanje i u nju upisuješ odgovarajuće vrednosti iz shPodaci
Code:
'Zaglavlje
shSlanje.Range("B6").Value = pred 'Primatelj
shSlanje.Range("C6").Value = shPodaci.Cells(startRow, 2).Text ' 10 ZA
shSlanje.Range("B7").Value = shPodaci.Cells(startRow, 3).Text 'Broj racuna
rw = 10
novasvrha = True
' Stavke grupisane po svrsi
Do While startRow <= stopRow
If novasvrha Then
shSlanje.Cells(rw, 2).Value = shPodaci.Cells(startRow, 4) ' Svrha
novasvrha = False
Iznos = 0
rw = rw + 2
End If
shSlanje.Cells(rw, 1).Value = shPodaci.Cells(startRow, 5).Value ' Namena
shSlanje.Cells(rw, 2).Value = shPodaci.Cells(startRow, 6).Value ' Opis
shSlanje.Cells(rw, 3).Value = shPodaci.Cells(startRow, 7).Value ' ZZZ
shSlanje.Cells(rw, 4).Value = shPodaci.Cells(startRow, 8).Value ' Iznos
Iznos = Iznos + shPodaci.Cells(startRow, 8).Value
rw = rw + 1 ' sledeci red
startRow = startRow + 1
If shPodaci.Cells(startRow, 4).Text <> shPodaci.Cells(startRow - 1, 4).Text Then
rw = rw + 1
' Ispisi Total
shSlanje.Cells(rw, 1).Value = "Ukupno"
shSlanje.Cells(rw, 1).Font.Bold = True
shSlanje.Cells(rw, 4).Value = Iznos
shSlanje.Cells(rw, 4).Font.Bold = True
rw = rw + 5 ' preskoci redove
novasvrha = True
End If
Loop
4/ Čuvanje i zatvaranje radne sveske
Na kraju kad je radna sveska formirana treba je snimiti pod ogovarajućim imenom
Code:
sFileName = "C:\Spisak 10\" & prim & "-" & shPodaci.Cells(rw, 2) & ".xls"
wbk.SaveAs sFileName
wbk.Close
u promneljivoj sFileName formiraš naziv radne sveske koji želiš, uključujući i fasciklu u koju se snima. U primeru je naziv tipa RAČUN-10 ZA.xls
To bi otprilike bilo to. Na osnovu ovoga pokušaj da sama napraviš makro za prepis podataka iz početne specifikacie da prepiše na kraj liste sa podacima.
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
[Excel] Makro za sređivanje spiska
