Njuton,
Gjeta kohėn pėr tė shkruajtur funksionin nė VBA pėr atė qė kėrkon tė bėsh.
Nė skedarin e bashkėngjitur (plotesim_shembull_DB.zip) do gjesh njė databazė shembull me njė tabelė, modulėn e kodit VBA, dhe njė macro. Macro-ja thėrret funksionin ploteso("tabela1", "id", 40000, 50000) . Funksioni hap tabelėn "tabela1" dhe shton tė gjitha id qė mungojnė midis 40000 dhe 50000. "id" eshte emri i kolones sė tabelės qė do tė plotėsosh.
Ky ėshtė kodi nė VBA:
Kodi:
' Autori: Edi (edspace@comcast.net)
' Faqja: Forumi Shqiptar
'************************************************************************************************
' Ploteson kolonen me vlerat [fillim, fillim + 1, fillim + 2, ..., mbarim - 2, mbarim - 1, mbarim]
' Funksioni plotėson vetėm rreshtat qė nuk ekzistojnė; nuk bėn ndryshime nė rreshtat ekzistues.
'
' Pėr ta pėrdorur, krijoni njė macro me veprimin (Action) RunCode dhe tek funksioni shkruani
' emrin e funksionit dhe argumentat.
'
' P.Sh.: ploteso ("tabela1","id", 40000, 50000)
' Shembulli do plotėsojė kolonėn "id" nė tabelėn "tabela1" me vlerat 40000 deri nė 50000.
'
'************************************************************************************************
Option Compare Database
Function ploteso(tabela As String, kolona As String, fillim As Long, mbarim As Long)
On Error GoTo GABIM
Dim db As Database
Dim rst As Recordset
Set db = CurrentDb()
Dim sql As String
' zgjedhim vetem rekordet ku kolona eshte midis fillimit dhe mbarimit
sql = "select " & kolona & _
" from " & tabela & _
" where " & kolona & " between " & fillim & " and " & mbarim & _
" order by " & kolona
Set rst = db.OpenRecordset(sql)
' per cdo vlere midis fillimit dhe mbarimit, kontrollojme nese
' ekziston ne databaze, dhe nese nuk e kziston, e shtojme
Do While fillim <= mbarim
If rst.EOF Then
Call shtoRekorde(rst, kolona, fillim, mbarim)
Exit Do
ElseIf rst.Fields(kolona) > fillim Then
Call shtoRekorde(rst, kolona, fillim, rst.Fields(kolona) - 1)
fillim = rst.Fields(kolona)
ElseIf rst.Fields(kolona) = fillim Then
rst.MoveNext
fillim = fillim + 1
Else
rst.MoveNext
End If
Loop
rst.Close
MsgBox "Rekordet u plotėsuan me sukses!"
DALJE:
Set rst = Nothing
Set db = Nothing
Exit Function
GABIM:
MsgBox "Diēka shkoi gabim!"
Resume DALJE
End Function
'********************************************************************************************************
' Ploteson kolonen ne rst me vlerat [fillim, fillim + 1, fillim + 2, ..., mbarim - 2, mbarim - 1, mbarim]
' Kujdes: Ky funksion i shton rreshtat edhe nese ekzistojne, kėshtu qė duhet patur kujdes me argumentat
' fillim...mbarim nėse nuk doni tė krijoni dy rreshta me tė njėjtėn vlerė
'********************************************************************************************************
Function shtoRekorde(rst As Recordset, kolona As String, fillim As Long, mbarim As Long)
On Error GoTo GABIM
For i = fillim To mbarim
rst.AddNew
rst.Fields(kolona) = i
rst.Update
Debug.Print ("Shtuam " & CStr(i)) ' printon rreshtat qe shtohet ne dritaren debug
Next i
Exit Function
GABIM:
MsgBox "Gabim nė shtimin e rreshtit " & CStr(i)
End Function
Nga testat qė bėra, jam i bindur se programi punon siē duhet, por pėr siguri, ruaj njė kopje rezervė tė databazės para se ta pėrdorėsh funksionin mė lart.
Pėrgjigju Duke Cituar
Krijoni Kontakt