• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Databanka

Zaslal/a Dejavu 14.9.2012 21:45

Zdravím všechny místní Guru,
5eším nyní tento problém a bohužel si nevím rady..

Jedná se o to, že mé dva stejné sešity umístěné na 2 PC používají poznámky typu (1. kus, 1. kus opeace 10, 1. kus operace 20 atp..) dále obsahují jména pracovníků a jejich čísla razítek. Dat může být max. na 200-300 řádků, více neočekávám..

Chci se vyvarovat toho, aby se poznámky psaly pokaždé jinak, proto ten seznam... a aby byly stejné, musím mít jejich databázi, ale vždy se může objevit nějaká nová poznámka, proto bych potřeboval, aby se přidávaly poznámky z obou sešitů do stejného souboru, který bude na síťovém disku a odtud si pak zpětně budou tato data tahat..

Bude to fungovat tak, že na každém z oněch 2 PC bude vzorová evidence, která se bude kopírovat, když bych tedy přidal poznámku normálně, uložila by se mi jen do té jedné dané evidence, ale vzorový sešit by tuto změnu již nezaznamenal...

Zatím jsem z internetu vytlačil toto, ale jsem začátečník ve VBA a makro nemohu rozběhnout, tak snad s tím něco zmůžete vy...

Dim CestaSouborDatabanka As String

Sub NacistData()

'cesta k sešitu se zdroji dat
CestaSouborDatabanka = ThisWorkbook.Path & "\databanka.xls"

PoleData = ZiskejDataTyp0("List Data")
PoleDataPrvniZaznam = Split(ZiskejDataTyp0("List Data")(0), ";")
PoleJmena = ZiskejDataTyp1("List Data", "JMENO")

End Sub

Function ZiskejDataTyp0(List As String)
'Tools / References / Microsoft ActiveX Data Objects Library x.x

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim str As String
Dim Dotaz As String
Dim Pole

'navázání spojení
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CestaSouborDatabanka & ";" & _
"Extended Properties=""Excel 8.0;"""

'sestavení SQL dotazu
'vyber veškerá data
Dotaz = "SELECT * FROM [" & List & "$];"

Debug.Print Dotaz

rs.Open Dotaz, _
cn, adOpenKeyset, adLockOptimistic

rs.MoveFirst
str = rs.GetString(adClipString, , ";", vbCrLf)
str = Left(str, Len(str) - 2)

Pole = Split(str, vbCrLf)

ZiskejDataTyp0 = Pole

'ukončení spojení a uvolnění z paměti
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

End Function

Function ZiskejDataTyp1(List As String, Sloupec As String)
'Tools / References / Microsoft ActiveX Data Objects Library x.x

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim str As String
Dim Dotaz As String
Dim Pole

'navázání spojení
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CestaSouborDatabanka & ";" & _
"Extended Properties=""Excel 8.0;"""

'sestavení SQL dotazu
'vyber neprázdné, neduplicitní,
'vzestupně seřazené položky daného sloupce
Dotaz = "SELECT DISTINCT " & Sloupec & _
" FROM [" & List & "$] WHERE " & _
Sloupec & "<>'' ORDER BY " & Sloupec & ";"

Debug.Print Dotaz

rs.Open Dotaz, _
cn, adOpenKeyset, adLockOptimistic

rs.MoveFirst
str = rs.GetString(adClipString, , ";", vbCrLf)
str = Left(str, Len(str) - 2)

Pole = Split(str, vbCrLf)

ZiskejDataTyp1 = Pole

'ukončení spojení a uvolnění z paměti
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

End Function

Kód se mi vždy zastaví v tomto místě :

rs.Open Dotaz, _
cn, adOpenKeyset, adLockOptimistic

Předem děkuji za jakoukoliv radu.

Uzamčeno - nelze přidávat nové příspěvky.

---

Strana:  « předchozí  1 2

Dejavu(19.9.2012 11:50)#009533

Tak to je fajn :)

Díky moccitovat

Strana:  « předchozí  1 2

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse