Second Opinion
Folosind serviciul second opinion ne puteți trimite RMN-uri, CT -uri, angiografii, fișiere .pdf, documente medicale. Astfel vă vom putea da o opinie neurochirurgicală, fără ca aceasta să poată înlocui un consult de specialitate. Răspunsurile vor fi date prin e-mail în cel mai scurt timp posibil (de obicei în mai putin de 24 de ore, dar nu mai mult de 48 de ore). Second opinion – Neurohope este un serviciu gratuit. www.neurohope.ro |
Export in xls files
Last Updated: Nov 09 2005 10:23, Started by
caesar_sw
, Nov 04 2005 10:10
·
0
#1
Posted 04 November 2005 - 10:10
Salut...
Care va pricepeti la Access si VB am o chestiune de rezolvat .. O tabela in Acces contine camp1 | camp2 --------------- xxxx | ssss yyyy | lllllll etc..... Vreau sa export toate inregistrarile din tabela in fisiere xls astfel toate inregistrarile care au xxxx pe camp1 in xxxx.xls toate inregistrarile care au yyyy pe camp1 in yyyy.xls etc. Treaba trebuie facuta in spatele unui buton...ceva simplu in Acces Pt export se foloseste DoCmd.TransferSpreadsheet dar nu prea stiu cum fac legatura intre numele campului si numele fisierului in care urmeaza sa export. Poate cineva sa dea un exemplu , cum s-ar face chestiuta asta? Merci. |
#2
Posted 05 November 2005 - 22:37
incearca cu procedura de mai jos, insa inainte trebuie sa faci un select pt inreg care te intereseaza pe tine (in loc de table poti folosi si un recordset, pe acesta din urma il poti pasa ca argument procedurii)
'pune un tabel dintr-un mdb intr-un fisier .xls incepand cu celula (row,col), tabela se afla in baza curenta cu care lucrezi Public Sub PutTableInExcel(strPathFileExcel As String, strNameTable As String, row As Long, col As Long) Dim xlApp As New Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim rs As Recordset Dim i As Long, j As Long, k As Long If Dir(strPathFileExcel) <> "" Then Set xlApp = New Excel.Application Set xlBook = xlApp.Workbooks.Open(strPathFileExcel) Set xlSheet = xlBook.Worksheets(1) Set rs = db.OpenRecordset(strNameTable, dbOpenDynaset) 'xlSheet.Name = "prima" i = row j = col Do Until rs.EOF For k = 0 To rs.Fields.Count - 1 xlBook.Sheets(1).Cells(i, k + j) = rs.Fields(k) Next k rs.MoveNext i = i + 1 Loop xlBook.Save xlBook.Close xlApp.Quit Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing Else MsgBox "Nu exista fisierul.", vbCritical, strE End If End Sub cu respect, romi |
#3
Posted 08 November 2005 - 08:17
Merci Romi.
Nu este varianta cea mai fericita...pentru mine, plus ca la linia asta xlBook.Sheets(1).Cells(i, k + j) = rs.Fields(k) nu prea merge...., NU stie sa creeze fisierele xls si n-am sapat mai departe... Iata rezolvarea: Option Compare Database Option Explicit Dim strCriteria As String Function funGetCriteria() funGetCriteria = strCriteria End Function Public Function ExportTable() Dim qdf As QueryDef Dim rs As Recordset Dim strSql As String Dim strPath As String strPath = "C:\YourPath" strSql = "SELECT nume_tabela.[name1] FROM nume_tabela" Set qdf = CurrentDb.CreateQueryDef("", strSql) Set rs = qdf.OpenRecordset Do While Not rs.EOF strCriteria = rs![name1] Debug.Print funGetCriteria DoCmd.OutputTo acOutputQuery, "your_Query", acFormatXLS, strPath & strCriteria & ".xls" rs.MoveNext Loop MsgBox "Export Done", vbOKOnly, "Export Files" Set rs = Nothing Set qdf = Nothing End Function Trebuie facut your_Query in care am adaugat la Criteria: =funGetCriteria() Numai bine. |
#4
Posted 09 November 2005 - 04:34
salut,
ai adaugat referinte la excel la projectul din vb? in mod normal ar tb sa mearga numai bine, romi |
#5
Posted 09 November 2005 - 10:23
romi, on Nov 9 2005, 04:34, said: salut, ai adaugat referinte la excel la projectul din vb? in mod normal ar tb sa mearga numai bine, romi Salut, Da, aveam referinte la excel, la linia respectiva imi zicea ceva de genul ca ce e dreapta nu se pupa cu ce e in stanga. Problema majora e ca varianta ta nu creaza singura fisierele xls, ele trebuie sa existe. Oricum merci, am rezolvat-o cum am scris mai sus. |
Anunturi
▶ 0 user(s) are reading this topic
0 members, 0 guests, 0 anonymous users