Prikazi cijelu temu 02.12.2010 17:47
Zuko Van mreze
Clan
Registrovan od:13.09.2010
Lokacija:Sarajevo


Predmet:Re: Prenos podatak VB-a kodom iz Access-a u Excel
evo napiso sam objašnjenja prcedure
PreuzmiIzvorni kôd (vbnet):
  1. Private Sub Workbook_Open()
  2.    Dim db As database 'Odreivanje varijabli'
  3.    Dim Rs As Recordset 'Odreivanje varijabli'
  4.    Dim Vork As Worksheet 'Odreivanje varijabli'
  5.    Dim SQL As String  'Odreivanje varijabli'
  6.    Dim Putanja As String 'Odreivanje varijabli'
  7.    Dim ImePrije As String 'Odreivanje varijabli'
  8.    Dim I As Integer 'Odreivanje varijabli'
  9.    Dim Brojac As Integer 'Odreivanje varijabli'
  10.    Dim Izmjena As String 'Odreivanje varijabli'
  11.    Dim R 'Odreivanje varijabli'
  12.    Putanja = Me.Path & "\Du.mdb" 'Odreivanje putanje'
  13.    Set db = OpenDatabase(Putanja) 'Setovanje baze'
  14.    Izmjena = db.Transactions 'Odreivanje varijable'
  15.    SQL = "SELECT ImePrezime,VrstaPoslova,GrupaPosla,NazivPosla, " _ 'Upit'
  16.        & "SumBrojUnosa, Unos_u_proc " _
  17.        & "FROM podaci " _
  18.        & "ORDER BY podaci.ImePrezime"
  19.    Set Rs = db.OpenRecordset(SQL) 'Odreivanje Recorseta'
  20.    Izmjena = Rs.RecordCount 'Broj slogova'
  21.    Set Vork = Me.Worksheets("a") 'Setovanje Worksheet-a'
  22.    If Vork.Cells(1, 1) = Izmjena Then 'Uslov za odrediÅ¡te odatka'
  23.       R = MsgBox("Nema izmjena" & vbCrLf & "Hes li ponovo upisati", vbYesNo + _ 'Porozor poruke'
  24.       vbExclamation + vbApplicationModal + vbDefaultButton2, "Napomena")
  25.       Select Case R 'Case petlja'
  26.          Case vbYes: 'Ako je odgovor Yes'
  27.          GoTo Start  'Idi na start
  28.       Case vbNo: 'Ako je odgovor No'
  29.          GoTo Kraj: 'Idi na kraj
  30.       End Select 'Kraj Case petlje'
  31.    Else 'Ina e'
  32.       Start: 'Idi na strat'
  33.       Vork.Cells(1, 1) = Izmjena 'Odreivanje odrediÅ¡ta podataka'
  34.    End If 'Kraj if uslova'
  35.    Application.DisplayAlerts = 0 'neznam Å¡ta baÅ¡ radi(Bukvalno prevedeno prikazi upozorenje 0)'
  36.    For Each Vork In ThisWorkbook.Worksheets 'For Each petlja za svaki radni sheet u excel file-u'
  37.       If Vork.Name <> "a" Then 'if pettlja ako je ime radnog sheet-a razli ito od sheet-a "a"'
  38.          Vork.Delete 'Ovrisi radni sheet'
  39.       End If 'kraj petlje'
  40.    Next Vork 'Sljedei raddni sheet'
  41.    Brojac = 1 'Odreivanje varijable brojac'
  42.    Do While Not Rs.EOF()  'Do petlja dok nije kraj Recordset-a'
  43.       Brojac = Brojac + 1 'Povecavamo brojac za jedan'
  44.       If ImePrije <> Rs!ImePrezime Then 'If petlja ako je varijabla Imeprije razlicita od Vrjednosti iz Recordset-a'
  45.          Set Vork = Sheets.Add 'Dodajemo novi radni sheet'
  46.          Vork.Name = Rs!ImePrezime 'Odreujemo mu ime'
  47.          Vork.Cells(1, 1) = "Vrsta posla" 'Upisujemo podarak Naslov kolona'
  48.          Vork.Cells(1, 2) = "Grpa Posla"  'Upisujemo podarak Naslov kolona'
  49.          Vork.Cells(1, 3) = "Naziv Posla" 'Upisujemo podarak Naslov kolona'
  50.          Vork.Cells(1, 4) = "Broj Unosa"  'Upisujemo podarak Naslov kolona'
  51.          Vork.Cells(1, 5) = "Procenat Unosa" 'Upisujemo podarak Naslov kolona'
  52.          Brojac = 2 'Odreujemo varijablu Brojac'
  53.      End If ?kraj uslova'
  54.      For I = 1 To 5 'For petlja za i od 1 do 5'
  55.          Vork.Cells(Brojac, I) = Rs.Fields(I) 'Odreujemo radni sheet'
  56.      Next I 'kraj petlje'
  57.      ImePrije = Rs!ImePrezime 'Promjena vrjednosti varijable Imeprije'
  58.      Rs.MoveNext 'Ubacivanje nove vrjednosti u Recordset'
  59.    Loop 'Kraj DO Loop petlje'
  60.    Application. = 1 'neznam Å¡ta baÅ¡ radi(Bukvalno prevedeno prikazi upozorenje 1)'
  61.    Kraj: 'Opis kraj-a'
  62.    Set db = Nothing 'Ubaci nista u setovanje baze'
  63.    Set Rs = Nothing 'Ubaci nista u setovanje Recodset-a'
  64. End Sub

Pozdav,

Nedim
Ovaj post je ureden 1 puta. Posljednja izmjena 02.12.2010 17:48 od strane nzuko.