Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

Access Baza Znanja

[es] :: Access :: Access Baza Znanja
(TOP topic, by Getsbi)
Strane: 1 2 3 4 5

[ Pregleda: 93264 | Odgovora: 82 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Access Baza Znanja28.04.2004. u 17:59 - pre 242 meseci
Na ovaj topik mozete da odgovarate tako sto cete nam pokazati vasu omiljenu korisnicku funkciju ili metod rada, nesto nedokumentovano o Accessu ili sta god mislite da bi nekome drugome moglo biti od koristi. Nemojte odgovarati na tudje postove ovde. Ako osecate potrebu da odgovorite ili se nadovezete na neki post, molim da to izdvojite kao posebnu temu i onda cemo da se prepiremo do mile volje, ali ne ovde.

Da bi olaksali pretrazivanje, molim da svaki post u ovoj temo pocnete opisom oblasti na koju se post odnosi. Za pocetak, evo oblasti: QUERY, Reports, Forms, VBA, Macros.

Ja cu sad sam sebi da odgovorim na ovo jednim postom na temu Query, da pokazemo primer kako bi to trebalo da izgleda.
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja28.04.2004. u 18:29 - pre 242 meseci
QUERY

(Q) Kako kvqrijem procitati nazive objekata u tekucem MDB fajlu(queries /forms/ table/ reports/ modules/ macros) ?

(A) Accessova systemska tabela MsysObjects sadrzi listu svih database objekata. Ovo nije dokumentovano niti podrzano od strane Microsofta, ali radi. Tabelu MsysObjects mozete videti ako idete na Tools/Options/View i cekirete System Objects.

Paznja: Od verzije do verzije Accessa, Microsft moze da promeni strukturu i sadzaj tabele MsySObjects, pa mozete da experimentisete malo ako treba. Sistemske tabele su read-only, pa nema straha da cete nesto pokvariti.




'******************** Code Start ************************
Da dobijete listu objekata iz tekuceg MDB fajla, mozete koristiti sledec kverije:

Queries:
SELECT MsysObjects.Name, MsysObjects.Name
FROM MsysObjects
WHERE (
((MsysObjects.Name) Not Like "~*")
AND ((MsysObjects.Type)=5)
)
ORDER BY MsysObjects.Name;



Forms:
SELECT MSysObjects.Name FROM MsysObjects
WHERE (
((MsysObjects.Type)=-32768)
AND ((MsysObjects.Name) Not Like "~*")
)
ORDER BY MsysObjects.Name;

Tables:
SELECT Name, Type, Name, Name, Connect, Database
FROM MsysObjects
WHERE (((Type) In (4,1,6)) AND ((Name) Not Like "Msys*") AND ((Name) Not Like "~*"))
ORDER BY Name;
Paznja: MSysObjects.Type je razlicit za lokalne, attachovane i ODBC tabele. Za ODBC tabele (SQL, ORACLE) polje Connect ce imati neki sdrzaj, za attachovane tabele polje Database imace neki sadrzaj, a za lokalne oba polja su NULL

Reports:
SELECT MSysObjects.Name
FROM MsysObjects
WHERE (
((MsysObjects.Type)=-32764)
AND ((MsysObjects.Name) Not Like "~*")
)
ORDER BY MsysObjects.Name;

Modules:
SELECT MsysObjects.Name, MsysObjects.Name
FROM MsysObjects
WHERE (
((MsysObjects.Type)=-32761)
AND ((MsysObjects.Name) Not Like "~*")
)
ORDER BY MsysObjects.Name;


Macros:
SELECT MSysObjects.Name FROM MsysObjects
WHERE (
((MsysObjects.Type)=-32766)
AND ((MsysObjects.Name) Not Like "~*")
)
ORDER BY MsysObjects.Name;

'******************** Code End ************************
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja28.04.2004. u 18:46 - pre 242 meseci
DATUMSKE FUNKCIJE

Kako se racuna starost osobe, na odredjeni dan, ako je zadat rodjendanski datum. Na primer, ako ste rodjeni 12 Oct 1991, 10 Oct 2001 imacete 9 godina, a 16 oct 2001 imacete 10 godina.

(A) Evo nekoliko funkcija koje to rade:

Ako pretpostavimo da se polje sa datumom rodjenja zove [BDate] i da je data ype date, sledeci izraz movraca godine starosti. Moze se koristiti i u kveriju, bice brze nego koristiti korisnicke funkcije:

Age=DateDiff("yyyy", [Bdate], Now())+ _
Int( Format(now(), "mmdd") < Format( [Bdate], "mmdd") )

Opcije: Mogu se koristiti i sledece dve funkcije:

a) vraca srtarost u godinama:
Function Age(Bdate, DateToday) As Integer
' Returns the Age in years between 2 dates
' Doesn't handle negative date ranges i.e. Bdate > DateToday

If Month(DateToday) < Month(Bdate) Or (Month(DateToday) = _
Month(Bdate) And Day(DateToday) < Day(Bdate)) Then
Age = Year(DateToday) - Year(Bdate) - 1
Else
Age = Year(DateToday) - Year(Bdate)
End If
End Function

b) Jos jedna detaljna funkcija, racuna starost u godinama, mesecima i danima

'--- CODE START ---
Public Sub CalcAge(vDate1 As Date, vdate2 As Date, ByRef vYears As Integer,
ByRef vMonths As Integer, ByRef vDays As Integer)
' Comments : calculates the age in Years, Months and Days
' Parameters:
' vDate1 - D.O.B.
' vDate2 - Date to calculate age based on
' vYears - will hold the Years difference
' vMonths - will hold the Months difference
' vDays - will hold the Days difference
vMonths = DateDiff("m", vDate1, vdate2)
vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2)
If vDays < 0 Then
' wierd way that DateDiff works, fix it here
vMonths = vMonths - 1
vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2)
End If
vYears = vMonths \ 12 ' integer division
vMonths = vMonths Mod 12 ' only want leftover less than one year
End Sub
'--- CODE END ---
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja28.04.2004. u 18:59 - pre 242 meseci
QUERY

Kako napraviti da u kveriju svaki rekord ima u nekom polju sumu svih rekorda pre njega (running sum query)?

Ovo mozemo da uradimo ako data set koji sumiramo ima autonumber polje ili numericki jedinstveni kjuc za svaki red koji kveri vraca.
RunningSum query koristi subquery da sumira sve rekorde gde je kljuc manji ili jednak tekucem. Na primer:

RunningSum: (Select Sum (OrderTotal) FROM [Orders] as Temp
WHERE [Temp].[OrderID] <= [Orders].[OrderID])

Za velike setove podataka, ovakav query moze da bude dosta spor.
Ako vam running total treba za prikazivanje u izvestaju, bolje je koristiti properti RunningSum za kontrolu na reportu. radi mnogo brze nego query-subquery.
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja28.04.2004. u 19:11 - pre 242 meseci
VBA

Kako iz VBA koda aktivirati zvuk? Funkcija PlaySound se poziva kao
=PlaySound("C:\WINDOWS\media\chord.wav")

WAV fajlovi proizvode bazicne zvuke. Ima i zvuk registar kase, sudar automobila, pucanje stakla, skripa kocnica, pa pustite masti navolju, pa kad korisnik unese nesto lose, e onda ga upucajte zvukom pistolja. :-)

'******* CODE START

Option Compare Database
Option Explicit

Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" _
(ByVal filename As String, ByVal snd_async As Long) As Long


Function PlaySound(sWavFile As String)
' Purpose: Plays a sound.
' Argument: the full path and file name.
'call: PlaySound("C:\WINDOWS\media\chord.wav")
If apisndPlaySound(sWavFile, 1) = 0 Then
MsgBox "The Sound Did Not Play!"
End If
End Function

'****** CODE END
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja29.04.2004. u 15:23 - pre 242 meseci
FORMS
- Kako upotrebiti Combo Box da se forma pozicionira na trazeni rekord

Upozorenje: U Access 97 iranijim verzijama ovo moze da izazove bookmark bug .
Vidi site http://members.iinet.net.au/~allenbrowne/BugBookmark.html
Ako dobijete Error u Accessu 2000 ili 2002, moguce je da imate probleme sa Referencama. Vidi site:http://members.iinet.net.au/~allenbrowne/ser-38.html

Jedan od nacina za kretanje kroz bazu podataka jeste upotreba combo boxa za pretrazivanje. Combo box mora biti unbound (nije vezan za polja u forminom record source). Ideja je da korisnik izbere nesto iz padajuce liste i da onda Access prikaze u formi taj slog (record).

Pretpostavimo da je record source za formu tabela "tblCustomers" sa sledecom strukturom:

CustomerID Text (indexed as Primary Key).
Company Text
ContactPerson Text

Forma prikazuje podatke kao Single Form. Dodajte combo box u zaglavlje forme (Forms Header) i neka conbo box ima sledece properties:

Name cboMoveTo
Control Source [ostvite ovo prazno!]
Row Source Type Table/Query
Row Source tblCustomers
Column Count 3
Column Widths 0.6 in; 1.2 in; 1.2 in
Bound Column 1
List Width 3.5 in
Limit to List Yes

Zapazite da je Control Source za Combo box PRAZAN. Row source jeste ono sto se vidi u padajucoj listi.

Ovo je kod na AfterUpdate za Combo Box:

Sub CboMoveTo_AfterUpdate ()
Dim rs As DAO.Recordset

If Not IsNull(Me!cboMoveTo) Then
'Sacuvajmo tekuci record pre pomeranja na novi:
If Me.Dirty Then
Me.Dirty = False
End If

'Kloniramo formin recordset i tu napravimo pretragu:
Set rs = Me.RecordsetClone
rs.FindFirst "[CustomerID] = " & Me!cboMoveTo
If rs.NoMatch Then
'za slucaj da ne nadjemo record
MsgBox "Trazeni slog nije nadjen. Da nije mozda Filter aktivan?"
Else
'Ovim pozicioniramo formu na zeljeni record
Me.Bookmark = rs.Bookmark
End If
Set rs = Nothing
End If
End Sub

Upozorenje: ako je CustomerID Text polje, onda treba uotrebiti znake navoda kod pretrazivanja:

rs.FindFirst "[CustomerID] = """ & Me!cboMoveTo & """"
 
Odgovor na temu

konstantin

Član broj: 17262
Poruke: 132
*.com



Profil

icon Re: Access Baza Znanja03.05.2004. u 10:49 - pre 242 meseci
Nije su mi bas omiljene, ali su mi jednom bile jako,jako korisne:

TOP n PERCENT i Rnd funkcije:

SELECT TOP 15 PERCENT My_table.*
FROM My_table
ORDER BY Rnd([ID]);
'Konkretan primjer kako iz tabele My_table dobiti 15 procenata slogova, slucajno izabranih na osnovu polja ID.

 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja12.05.2004. u 14:23 - pre 241 meseci
Expirienced Tips - ovj prilog dao je byTer
----------- ----

Ukoliko se desi da kljucne reci kao sto su Text, string, itd (ne znam ih ni ja sve) se nadju kao imena polja stavite apsolutnu putanju do tih tabela primer topics.text umesto samo text tako da cete moci da resite ovaj problem. Inace ukoliko se javi ovakav slucaj, interpretator SQLa vam nece javiti neku gresku (MS Access) vec
ce javiti samo da je greska u SQL statmentu.

Pozdrav.

____________________________
Još jedan prijatelj manje kakvo s***e.
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja15.06.2004. u 14:30 - pre 240 meseci
Ako cesto koristite akcione kverije u kode (Update, delete, Append), normalno se javklja Accessova poruka tipa "Are you sure you want to update 150 records.."
Ponekad ne zelimo da se takve poruke vide, pa ih onda iskljucimo. Na primer:
Code:

'Iskljucimo poruke:
DoCmd.SetWarnings False
'Izvrsimo akcioni kveri
Docmd.OpenQuery "qryUpdateStanje"
'Ponovo vratimo poruke
DoCmd.SetWarnings True

Ako ocekujemo da se akcioni kveri izvrsava sporo, onda mozemo da pokazemo Hourglass, da korisnik zna da se nesto desava.
Code:

'Iskljucimo poruke:
DoCmd.SetWarnings False
'Uklucimo Hourglas
'DoCmd.SetHourglass True
'Izvrsimo akcioni kveri
Docmd.OpenQuery "qryUpdateStanje"
'Ponovo vratimo poruke
DoCmd.SetWarnings True
'Iskljucimo Hourglas:
DoCmd.Hourglass False


Problem 1 sa ovim je sto se mnogo pise DoCmd pa nas mrzi da to pisemo svaki cas. Drugo, ako kveri pukne, ne izvrsi se, puci ce i program - OK, imamo Error handling, prezivecemo. Problem 2 je sto ce Warnings da ostanu FALSE i Hourglas TRUE. Hourglas TRUE je neprijatan, jer se od tog momenta na dalje kursor ne vidi, vidi se pescani sat.

Problem 1 se resava upotrebom jednostavnih funkcija
Code:

Function WON()
'Purpose: turns Warnings ON
    DoCmd.SetWarnings True
End Function

Function WOF()
'Purpose: turns Warnings OFF
    DoCmd.SetWarnings False
End Function

Function HON()
'Purpose: turns HourGlass ON
    DoCmd.Hourglass True
End Function

Function HOF()
'Purpose: turns HourGlass OFF
    DoCmd.Hourglass False
End Function

i onda kod iz primera izgleda ovako:
Code:

WOF
HON
'Izvrsimo akcioni kveri
Docmd.OpenQuery "qryUpdateStanje"
WON
HOF


Za Problem 2, Hourglas koji ostaje ako se nesto desi - uklucite ga u Error handler
Code:

Function DoSoemthing()
 On Error GoTo ERROR_HANDLER
'.. neki kod dodje ispred
 WOF
 HON
'Izvrsimo akcioni kveri
 Docmd.OpenQuery "qryUpdateStanje"
 WON
 HOF
'..... ostatak koda ide ovde

EXIT HERE:
 On Error Resume Next
 WON
 HOF
 Exit Function

ERROR_HANDLER:
 Select case Err.Number
    Case Else
         MsgBox "Error " & err.number & vbcrlf & err.description & vbcrlf & " in DoSomething()"
 End Seelct
 Resume EXIT HERE:
End Function


Korisno je napraviti i makro koji odradjuje Hourglas FALSE. Ovo posebno vazi vreme razvoja aplikacije. Ponkead Access sam od sebe aktivira hourglass, program pukne i vi ostanete sa hourglass kursorom. Aktivirajte makro koji ce da ponisti Hourglass.


 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja21.06.2004. u 13:36 - pre 240 meseci
VBA PROGRAMIRANJE

U Accessu cesto imamo potrebu da sagradimo ceo SQL string ili jedan deo. Znate ono kao:
Code:

strSQL = "SELECT Poje1, Polje2 FROM myTable WHERE Polje1='Laza'"
set rs=db.openrecordset(strSQL)



Problem je WHERE iskaz. Nikada se ne kodira WHERE Polje1='Laza', mnogo cesce ide nesto kao
Code:

"WHERE Polje=" & txtPolje1


gde rezultat mora da bude validan SQL string (onaj koji se moze izvrsiti).

Zavisno od tipa podataka za txtPolje1, problem se resava na razlicte nacine.
1) txtPolje je numericki podatak => upotrebiti " WHERE Polje=" & txtPolje1
2) txtPolje je tekstualni podatak => upotrebiti jedno od sledecih varijanti:
Code:

" WHERE Polje='" & txtPolje1 "'"
" WHERE Polje=" & chr$(34) & txtPolje1 & chr$(34)


3) txtPolje je DATUM => moraju se zadovoljiti dva uslova a) upotrebiti # kao delimiter b) datum mora biti formatiran u USA formatu "mm/dd/yyyy"
Code:

" WHERE Polje=" & "#" & Format(txtPolje1, "mm/dd/yyyy") & "#"



Previla za tekstualne podatke su teska za kucanje, pa se preporucuje upotreba funkcija za formatiranje:
Code:


Function EnQuote(varString As Variant)
EnQuote = Chr$(34) & Nz(varString, vbNullString) & Chr$(34)
End Function

Function SQLDate(Date2Convert As Variant) As String
'*** Changed on 22 Feb 2005, by ZIdar
'Forllowing code is OK for English speaking countries,
'but it does not work well for other regional settings
' SQLDate = "#" & Format(CVDate(Date2Convert), "mm/dd/yyyy") & "#"

'Code that works for other regional settings
'(tested for Serbian Cyrilic):
SQLDate = "#" & Format(Month(CVDate(Date2Convert)), "00") & "/" _
& Format(Day(CVDate(Date2Convert)), "00") _
& "/" & Format(Year(CVDate(Date2Convert)), "0000") & "#"

End Function

'Primeri:
" WHERE myDatum=" & SQLDate(myDatum)
" WHERE myDate BETWEEN " & SQLDate(myFromDate) & " AND " & SQLDate(myToDate)

" WHERE myTextPolje=" & EnQuote(myTextpolje)
" WHERE myTextPolje LIKE " & EnQuote(myTextpolje) & "*"
" WHERE myTextPolje LIKE " & "*" & EnQuote(myTextpolje) & "*"



Upotrebom funkcija kod se brze pise, smanjuje se verovatnoca greske i kod je mnogo citljiviji i razumljiviji.



[Ovu poruku je menjao Zidar dana 22.02.2005. u 15:44 GMT+1]
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja25.06.2004. u 13:51 - pre 240 meseci
VBA , $String funkcije - ispiisvanje stringa naopako

Na Serbian cafeu bilo je pitanje "Kako odstampati brojeve od unazad, tako da se broj 1234 stampa kao 4321". Ovo je resilo problem:
Citat:

Ni Access ni Excel nazalost nemaju funkciju koja ispisuje stringove naopako. Probaj ovo:

Function ReverseString(strToInvert As String) As String
'Purpose: reverses given string
'Example: ReverseString("1234567") returns "7654321"
Dim i As Integer
Dim L As Integer
Dim strTarget As String

L = Len(strToInvert)
strTarget = ""

For i = 1 To L
strTarget = Mid(strToInvert, i, 1) & strTarget
Next i

ReverseString = strTarget

End Function

Kopiras ovu funkciju u modul (ne na formu), da bi bila vidljiva zakverije. Onda spakujes brojeve u Access tabelu i onda napravis kveri, na primer:

SELECT Broj, ReverseString(Cstr(Broj)) AS Broj_Naopako
FROM tbltabelaSaBorjevima

:-)
Na printer se salje Broj_Naopako.


 
Odgovor na temu

Daks
Tu Tamo

Član broj: 2310
Poruke: 88
*.as54.bi.bih.net.ba.



Profil

icon Re: Access Baza Znanja30.06.2004. u 10:19 - pre 240 meseci
KAKO UKLJUČITI/ISKLJUČITI SHIFT KEY?

Kreirajte novi public modul. Kada ste u modulu idete na Tools pa zatim References. Ukljucite Microsoft DAO 3.6.


Slijedeći kod kopirate u taj novi modul:

'***************** Code Start ***************
'Koprati ovu funkciju u novi public modul
Public Function SetProperties(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
On Error GoTo Err_SetProperties
Dim db As DAO.Database, prp As DAO.Property
Set db = CurrentDb
db.Properties(strPropName) = varPropValue
SetProperties = True
Set db = Nothing

Exit_SetProperties:
Exit Function
Err_SetProperties:
If Err = 3270 Then
Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
db.Properties.Append prp
Resume Next
Else
SetProperties = False
MsgBox "SetProperties", Err.Number, Err.Description
Resume Exit_SetProperties
End If
End Function
'***************** Code End ***************


Potom slijedeći kod dodate u onClick proceduru command butona, labela ili čak neke slike kako bi uključivanje/isključivanje shift key-a bilo neprmjetno za korisnika:

'***************** Code Start ***************
'Dodati u OnClick proceduru command butona,
'labela ili slike "bIskljuciShift"
'Promijeniti default sifru "Vasa sifra ovdje" u Vašu sifru
Private Sub bIskljuciShift_Click()
On Error GoTo Err_bIskljuciShift_Click
Dim strInput As String
Dim strMsg As String
Beep
strMsg = "Zelite li omoguciti SHIFT key?" & vbCrLf & vbLf & _
"Molimo Vas upisite sifru za omogucivanje SHIFT key-a."
strInput = InputBox(Prompt:=strMsg, title:="Shift key nije omogucen")
If strInput = "Vasa sifra ovdje" Then
SetProperties "AllowBypassKey", dbBoolean, True
Beep
MsgBox "Shift key je ukljucen." & vbCrLf & vbLf & _
"Slijedeci put kad budete otvarali vasu bazu Shift key ce biti omogucen.", _
vbInformation, "Set Startup Properties"
Else
Beep
SetProperties "AllowBypassKey", dbBoolean, False
MsgBox "Sifra nije prihvacena!" & vbCrLf & vbLf & _
"Shift key je onemogucen." & vbCrLf & vbLf & _
"Slijedeci put kad budete otvarali bazu Shift key ce biti onemogucen.", _
vbCritical, "Netacna sifra"
Exit Sub
End If
Exit_bIskljuciShift_Click:
Exit Sub
Err_bIskljuciShift_Click:
MsgBox "bIskljuciShift_Click", Err.Number, Err.Description
Resume Exit_bIskljuciShift_ClickEnd Sub
'***************** Code End ***************


Kada zelite omoguciti Shift key kliknete na command buton (label) unesete sifru, zatvorite bazu i ponovo je otvorite drzeci Shift.
Kada zelite onemoguciti Shift key takodjer kliknite na command buton (label) unesite netačnu šifru i zatvorite bazu. Shift key će biti onemogućen.

Omer
 
Odgovor na temu

Simke
Marko Simic
Sandfield Associates (Solution
Developer)
Novi Zeland

Član broj: 1158
Poruke: 751
*.dialup.xtra.co.nz

ICQ: 71578686
Sajt: www.sandfield.co.nz


Profil

icon Re: Access Baza Znanja03.07.2004. u 00:47 - pre 240 meseci
Kako export-ovati objekat i Access-a u text fajl i import-ovati ga nazad

Ako dodje do korupcije ili ostecenja Access baze, obicno repair i/ili importovanje objekata u novi fajl pomaze. Ali ako ni ovo ne radi, onda mozete da koristite komandu Application.SaveAsText da snimite objekat u text fajl i da ga komandom Application.LoadFromText ucitate u novi Access fajl.

Ako imamo formu "frmProducts" i zelimo da je exportujemo u text fajl, onda:
Otvorite code editor i immediate (debug) prozoru kucajte
Application.SaveAsText acForm, "frmProducts", "C:\frmProducts.txt"

Za import se koristi:
Application.LoadFromText acForm "frmProducts", "C:\frmProducts.txt"
All beer is good. Some beer is better.
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja09.07.2004. u 13:33 - pre 240 meseci
Funkcija za konverziju novcanih iznosa u tekst, na srpskom.
Funkciju prilozili Mauzer i Daks, 8 Jul 2004.
[Code]
Function slovima(broj)

If broj = 0 Then rez = "nula"

ReDim imebr(9)
imebr(1) = "jedan"
imebr(2) = "dva"
imebr(3) = "tri"
imebr(4) = "cetiri"
imebr(5) = "pet"
imebr(6) = "sest"
imebr(7) = "sedam"
imebr(8) = "osam"
imebr(9) = "devet"

rez = ""
celi = Int(broj)
dec = ((broj - celi) * 100) Mod 100
cbr = Str(celi)
duzina = 16 - Len(cbr)
cbroj = String(duzina, "0") & Right(cbr, Len(cbr) - 1)

i = 1

Do While i < 15
tric = Mid(cbroj, i, 3)
trojka = Val(tric)
If tric <> "000" Then
cs = Val(Mid(tric, 1, 1))
cd = Val(Mid(tric, 2, 1))
cj = Val(Mid(tric, 3, 1))
Select Case cs
Case 2
rez = rez & "dve"
Case Is > 2
rez = rez & imebr(cs)
End Select

Select Case cs
Case 1
rez = rez & "stotinu"
Case 2, 3, 4
rez = rez & "stotine"
Case Is > 4
rez = rez & "stotina"
End Select

If cj = 0 Then sl1 = "" Else sl1 = imebr(cj)

Select Case cd
Case 4
rez = rez & "cetr"
Case 6
rez = rez & "sez"
Case 5
rez = rez & "pe"
Case 9
rez = rez & "deve"
Case 2, 3, 7, 8
rez = rez & imebr(cd)
Case 1
sl1 = ""
Select Case cj
Case 0
rez = rez & "deset"
Case 1
rez = rez & "jeda"
Case 4
rez = rez & "cetr"
Case Else
rez = rez & imebr(cj)
End Select
If cj > 0 Then rez = rez & "naest"
End Select

If cd > 1 Then rez = rez & "deset"

If (i = 4 Or i = 10) And cd <> 1 Then
If cj = 1 Then
sl1 = "jedna"
ElseIf cj = 2 Then
sl1 = "dve"
End If
End If

rez = rez & sl1

Select Case i

Case 1
rez = rez & "bilion"
If cj > 1 Or cd = 1 Then rez = rez & "a"

Case 4
rez = rez & "milijard"
If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Then
rez = rez & "i"
ElseIf cj = 1 Then
rez = rez & "a"
ElseIf cj > 4 Or cj = 0 Then
rez = rez & "i"
ElseIf cj > 1 Then
rez = rez & "e"
End If

Case 7
rez = rez & "milion"
If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Or cj <> 1 Then
rez = rez & "a"
End If

Case 10
rez = rez & "hiljad"
If ((trojka Mod 100) > 11 And (trojka Mod 100) < 19) Or cj = 1 Then
rez = rez & "a"
ElseIf trojka = 1 Then
rez = rez & "u"
ElseIf cj > 4 Or cj = 0 Then
rez = rez & "a"
ElseIf cj > 1 Then
rez = rez & "e"
End If

End Select
End If
i = i + 3
Loop

slovima = rez & Str(dec) & "/100"

End Function
[/code]

Potrebno je kreirati novi modul, na primer modPrevodBrojeva i iskopirati prilozeni kod.

Preporucuje se da se sve promenljive explicitno DIMenzionisu.




 
Odgovor na temu

Simke
Marko Simic
Sandfield Associates (Solution
Developer)
Novi Zeland

Član broj: 1158
Poruke: 751
*.dialup.xtra.co.nz

ICQ: 71578686
Sajt: www.sandfield.co.nz


Profil

icon Re: Access Baza Znanja11.08.2004. u 07:15 - pre 238 meseci
Access 2000 i korupcija adp fajlova.

Access 2000 ima jedan gadan bug, kada se uradi import nekog objekta u adp fajl da moze da dodje do korupcije fajla. Da bi se ovo sprecilo, bito je da se odmah nakon importa uradi compile celog projekta. Posle kompilacije zatvorite fajl i ponovo ga otvorite. Sada moze da se uradi i compact & repair, mada nije neophodno.
All beer is good. Some beer is better.
 
Odgovor na temu

Simke
Marko Simic
Sandfield Associates (Solution
Developer)
Novi Zeland

Član broj: 1158
Poruke: 751
*.dialup.xtra.co.nz

ICQ: 71578686
Sajt: www.sandfield.co.nz


Profil

icon Re: Access Baza Znanja22.08.2004. u 00:16 - pre 238 meseci
There is no licence poruka u Access 97

Pretpostavljam da retko ko ovde koristi Access 97, ali ipak da postavim resenje za ovo, posto sam naisao na problem par puta do sada.

Znaci uradite instalaciju Accessa, probate da startujete i pojavi se poruka: Microsoft Access can't start because there is no license for it on this machine.

Da bi resili problem uradite sledece:
1) Otvorite Find i uradite search za hatten.ttf fajl (Win\Fonts)
2) Uradite rename fajla u recimo hatten.xxx
3) Pokrenite setup za Office / Access 97 i izaberite opciju Reinstall.
4) Posle reinstalacije vratite ima fajla nazad u hatten.ttf
All beer is good. Some beer is better.
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja02.09.2004. u 17:22 - pre 238 meseci
Au Access 97 Helpu moze da se nadje ova funkcija. Funkcija kreira tebelu sa gotovo svim Access i JET Error kodovima i opisima. Do sada nisam nisao na nesto sto se razlikuje od 2002. Pitanje se pojavljivalo na raznim forumima pa ajde da ga imamo i ovde.

Code:

Function AccessAndJetErrorsTable() As Boolean
    Dim dbs As Database, tdf As TableDef, fld As Field
    Dim rst As Recordset, lngCode As Long
    Dim strAccessErr As String
    Const conAppObjectError = "Application-defined or object-defined error"

    On Error GoTo Error_AccessAndJetErrorsTable
    ' Create Errors table with ErrorNumber and ErrorDescription fields.
    Set dbs = CurrentDb
    Set tdf = dbs.CreateTableDef("AccessAndJetErrors")
    Set fld = tdf.CreateField("ErrorCode", dbLong)

tdf.Fields.Append fld
    Set fld = tdf.CreateField("ErrorString", dbMemo)
    tdf.Fields.Append fld

    dbs.TableDefs.Append tdf
    ' Open recordset on Errors table.
    Set rst = dbs.OpenRecordset("AccessAndJetErrors")
    ' Loop through error codes.
    For lngCode = 0 To 3500
        On Error Resume Next
        ' Raise each error.
        strAccessErr = AccessError(lngCode)
        DoCmd.Hourglass True
        ' Skip error numbers without associated strings.
        If strAccessErr <> "" Then

' Skip codes that generate application or object-defined errors.
            If strAccessErr <> conAppObjectError Then
                ' Add each error code and string to Errors table.
                rst.AddNew
                rst!ErrorCode = lngCode
                ' Append string to memo field.
                rst!ErrorString.AppendChunk strAccessErr
                rst.Update
            End If
        End If
    Next lngCode
    ' Close recordset.
    rst.Close
    DoCmd.Hourglass False
    RefreshDatabaseWindow
    MsgBox "Access and Jet errors table created."

AccessAndJetErrorsTable = True

Exit_AccessAndJetErrorsTable:
    Exit Function

Error_AccessAndJetErrorsTable:
    MsgBox Err & ": " & Err.Description
    AccessAndJetErrorsTable = False
    Resume Exit_AccessAndJetErrorsTable
End Function
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja10.09.2004. u 21:18 - pre 237 meseci
Pitanje je bilo: kako skalirati forme za razlicite rezolucije.
http://www.elitesecurity.org/tema/68006

Evo sta je Daks ponudio, a Obradorriuss potvrdio da to radi:

Kreiraj novi modul i nazovi ga npr. modResizeForm. u njega kopiraj slijedeci kod:


Option Compare Database
Option Explicit
'-----------------------------MODULE CONSTANTS & VARIABLES------------------------------
Private Const DESIGN_HORZRES As Long = 800 '<- CHANGE THIS VALUE TO THE RESOLUTION
'YOU DESIGNED YOUR FORMS IN.
'(e.g. 800 X 600 -> 800)
Private Const DESIGN_VERTRES As Long = 600 '<- CHANGE THIS VALUE TO THE RESOLUTION
'YOU DESIGNED YOUR FORMS IN.
'(e.g. 800 X 600 -> 600)
Private Const DESIGN_PIXELS As Long = 92 '<- CHANGE THIS VALUE TO THE DPI
'SETTING YOU DESIGNED YOUR FORMS IN.
'(If in doubt do not alter the
'DESIGN_PIXELS setting as most
'systems use 96 dpi.)
Private Const WM_HORZRES As Long = 8
Private Const WM_VERTRES As Long = 10
Private Const WM_LOGPIXELSX As Long = 88
Private Const TITLEBAR_PIXELS As Long = 18
Private Const COMMANDBAR_PIXELS As Long = 26
Private Const COMMANDBAR_LEFT As Long = 0
Private Const COMMANDBAR_TOP As Long = 1
Private OrigWindow As tWindow 'Module level variable holds the
'original window dimensions before
'resize.

Private Type tRect
left As Long
Top As Long
right As Long
bottom As Long
End Type

Private Type tDisplay
Height As Long
Width As Long
DPI As Long
End Type

Private Type tWindow
Height As Long
Width As Long
End Type

Private Type tControl
Name As String
Height As Long
Width As Long
Top As Long
left As Long
End Type
'-------------------------- END MODULE CONSTANTS & VARIABLES----------------------------

'------------------------------------API DECLARATIONS-----------------------------------
Private Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" _
() As Long

Private Declare Function WM_apiGetDC Lib "user32" Alias "GetDC" _
(ByVal hwnd As Long) As Long

Private Declare Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" _
(ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function WM_apiGetWindowRect Lib "user32.dll" Alias "GetWindowRect" _
(ByVal hwnd As Long, lpRect As tRect) As Long

Private Declare Function WM_apiMoveWindow Lib "user32.dll" Alias "MoveWindow" _
(ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Private Declare Function WM_apiIsZoomed Lib "user32.dll" Alias "IsZoomed" _
(ByVal hwnd As Long) As Long
'--------------------------------- END API DECLARATIONS----------------------------------

'---------------------------------------------------------------------------------------
' Procedure : getScreenResolution
' DateTime : 27/01/2003
' Author : Jamie Czernik
' Purpose : Function returns the current height, width and dpi.
'---------------------------------------------------------------------------------------
Private Function getScreenResolution() As tDisplay

Dim hDCcaps As Long
Dim lngRtn As Long

On Error Resume Next

'API call get current resolution:-
hDCcaps = WM_apiGetDC(0) 'Get display context for desktop (hwnd = 0).
With getScreenResolution
.Height = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)
.Width = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)
.DPI = WM_apiGetDeviceCaps(hDCcaps, WM_LOGPIXELSX)
End With
lngRtn = WM_apiReleaseDC(0, hDCcaps) 'Release display context.

End Function

'---------------------------------------------------------------------------------------
' Procedure : getFactor
' DateTime : 27/01/2003
' Author : Jamie Czernik
' Purpose : Function returns the value that the form's/control's height, width, top &
' left should be multiplied by to fit the current screen resolution.
'---------------------------------------------------------------------------------------
Private Function getFactor(blnVert As Boolean) As Single

Dim sngFactorP As Single

On Error Resume Next

If getScreenResolution.DPI <> 0 Then
sngFactorP = DESIGN_PIXELS / getScreenResolution.DPI
Else
sngFactorP = 1 'Error with dpi reported so assume 96 dpi.
End If
If blnVert Then 'return vertical resolution.
getFactor = (getScreenResolution.Height / DESIGN_VERTRES) * sngFactorP
Else 'return horizontal resolution.
getFactor = (getScreenResolution.Width / DESIGN_HORZRES) * sngFactorP
End If

End Function

'---------------------------------------------------------------------------------------
' Procedure : ReSizeForm
' DateTime : 27/01/2003
' Author : Jamie Czernik
' Purpose : Routine should be called on a form's onOpen or onLoad event.
'---------------------------------------------------------------------------------------
Public Sub ReSizeForm(ByVal frm As Access.Form)

Dim rectWindow As tRect
Dim lngWidth As Long
Dim lngHeight As Long
Dim sngVertFactor As Single
Dim sngHorzFactor As Single

On Error Resume Next

sngVertFactor = getFactor(True) 'Local function returns vertical size change.
sngHorzFactor = getFactor(False) 'Local function returns horizontal size change.
Resize sngVertFactor, sngHorzFactor, frm 'Local procedure to resize form sections & controls.
If WM_apiIsZoomed(frm.hwnd) = 0 Then 'Don't change window settings for max'd form.
Access.DoCmd.RunCommand acCmdAppMaximize 'Maximize the Access Window.
'Store for dimensions in rectWindow:-
Call WM_apiGetWindowRect(frm.hwnd, rectWindow)
'Calculate and store form height and width in local variables:-
With rectWindow
lngWidth = .right - .left
lngHeight = .bottom - .Top
End With
'Resize the form window as required (don't resize this for sub forms):-
If frm.Parent.Name = VBA.vbNullString Then
Call WM_apiMoveWindow(frm.hwnd, ((getScreenResolution.Width - _
(sngHorzFactor * lngWidth)) / 2) - getLeftOffset, _
((getScreenResolution.Height - (sngVertFactor * lngHeight)) / 2) - _
getTopOffset, lngWidth * sngHorzFactor, lngHeight * sngVertFactor, 1)
End If
End If
Set frm = Nothing 'Free up resources.

End Sub

'---------------------------------------------------------------------------------------
' Procedure : Resize
' DateTime : 27/01/2003
' Author : Jamie Czernik
' Purpose : Routine re-scales the form sections and controls.
'---------------------------------------------------------------------------------------
Private Sub Resize(sngVertFactor As Single, sngHorzFactor As Single, ByVal frm As Access.Form)

Dim ctl As Access.Control 'Form control variable.
Dim arrCtls() As tControl 'Array of Tab and Option Group control properties.
Dim lngI As Long 'Loop counter.
Dim lngJ As Long 'Loop counter.
Dim lngWidth As Long 'Stores form's new width.
Dim lngHeaderHeight As Long 'Stores header's new height.
Dim lngDetailHeight As Long 'Stores detail's new height.
Dim lngFooterHeight As Long 'Stores footer's new height.
Dim blnHeaderVisible As Boolean 'True if form header visible before resize.
Dim blnDetailVisible As Boolean 'True if form detail visible before resize.
Dim blnFooterVisible As Boolean 'True if form footer visible before resize.
Const FORM_MAX As Long = 31680 'Maximum possible form width & section height.

On Error Resume Next

With frm
.Painting = False 'Turn off form painting.
'Calculate form's new with and section heights and store in local variables
'for later use:-
lngWidth = .Width * sngHorzFactor
lngHeaderHeight = .Section(Access.acHeader).Height * sngVertFactor
lngDetailHeight = .Section(Access.acDetail).Height * sngVertFactor
lngFooterHeight = .Section(Access.acFooter).Height * sngVertFactor
'Now maximize the form's width and height while controls are being resized:-
.Width = FORM_MAX
.Section(Access.acHeader).Height = FORM_MAX
.Section(Access.acDetail).Height = FORM_MAX
.Section(Access.acFooter).Height = FORM_MAX
'Hiding form sections during resize prevents invalid page fault after
'resizing column widths for list boxes on forms with a header/footer:-
blnHeaderVisible = .Section(Access.acHeader).Visible
blnDetailVisible = .Section(Access.acDetail).Visible
blnFooterVisible = .Section(Access.acFooter).Visible
.Section(Access.acHeader).Visible = False
.Section(Access.acDetail).Visible = False
.Section(Access.acFooter).Visible = False
End With
'Resize array to hold 1 element:-
ReDim arrCtls(0)
'Gather properties for Tabs and Option Groups to recify height/width problems:-
For Each ctl In frm.Controls
If ((ctl.ControlType = Access.acTabCtl) Or _
(ctl.ControlType = Access.acOptionGroup)) Then
With arrCtls(lngI)
.Name = ctl.Name
.Height = ctl.Height
.Width = ctl.Width
.Top = ctl.Top
.left = ctl.left
End With
lngI = lngI + 1
ReDim Preserve arrCtls(lngI) 'Increase the size of the array.
End If
Next ctl
'Resize and locate each control:-
For Each ctl In frm.Controls
If ctl.ControlType <> Access.acPage Then 'Ignore pages in Tab controls.
With ctl
.Height = .Height * sngVertFactor
.left = .left * sngHorzFactor
.Top = .Top * sngVertFactor
.Width = .Width * sngHorzFactor
.FontSize = .FontSize * sngVertFactor
'Enhancement by Myke Myers --------------------------------------->
'Fix certain Combo Box, List Box and Tab control properties:-
Select Case .ControlType
Case Access.acListBox
.ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor)
Case Access.acComboBox
.ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor)
.ListWidth = .ListWidth * sngHorzFactor
Case Access.acTabCtl
.TabFixedWidth = .TabFixedWidth * sngHorzFactor
.TabFixedHeight = .TabFixedHeight * sngVertFactor
End Select
'------------------------------------> End enhancement by Myke Myers.
End With
End If
Next ctl
'********************************************************
'* Note if scaling form up: If Tab controls or Option *
'* Groups are too near the bottom or right side of the *
'* form they WILL distort due to the way that Access *
'* keeps the child controls within the control frame. *
'* Try moving these controls left or up if possible. *
'* The opposite is true for scaling down so in this *
'* case try moving these controls right or down. *
'********************************************************
'Now try to rectify Tabs and Option Groups height/widths:-
For lngJ = 0 To lngI
With frm.Controls.Item(arrCtls(lngJ).Name)
.left = arrCtls(lngJ).left * sngHorzFactor
.Top = arrCtls(lngJ).Top * sngVertFactor
.Height = arrCtls(lngJ).Height * sngVertFactor
.Width = arrCtls(lngJ).Width * sngHorzFactor
End With
Next lngJ
'Now resize height for each section and form width using stored values:-
With frm
.Width = lngWidth
.Section(Access.acHeader).Height = lngHeaderHeight
.Section(Access.acDetail).Height = lngDetailHeight
.Section(Access.acFooter).Height = lngFooterHeight
'Now unhide form sections:-
.Section(Access.acHeader).Visible = blnHeaderVisible
.Section(Access.acDetail).Visible = blnDetailVisible
.Section(Access.acFooter).Visible = blnFooterVisible
.Painting = True 'Turn form painting on.
End With
Erase arrCtls 'Destory array.
Set ctl = Nothing 'Free up resources.

End Sub

'---------------------------------------------------------------------------------------
' Procedure : getTopOffset
' DateTime : 27/01/2003
' Author : Jamie Czernik
' Purpose : Function returns the total size in pixels of menu/toolbars at the top of
' the Access window allowing the form to be positioned in the centre of the
' screen.
'---------------------------------------------------------------------------------------
Private Function getTopOffset() As Long

Dim cmdBar As Object
Dim lngI As Long

On Error GoTo err

For Each cmdBar In Application.CommandBars
If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_TOP)) Then
lngI = lngI + 1
End If
Next cmdBar
getTopOffset = (TITLEBAR_PIXELS + (lngI * COMMANDBAR_PIXELS))

exit_fun:
Exit Function

err:
'Assume only 1 visible command bar plus the title bar:
getTopOffset = TITLEBAR_PIXELS + COMMANDBAR_PIXELS
Resume exit_fun

End Function

'---------------------------------------------------------------------------------------
' Procedure : getLeftOffset
' DateTime : 27/01/2003
' Author : Jamie Czernik
' Purpose : Function returns the total size in pixels of menu/toolbars at the left of
' the Access window allowing the form to be positioned in the centre of the
' screen.
'---------------------------------------------------------------------------------------
Private Function getLeftOffset() As Long

Dim cmdBar As Object
Dim lngI As Long

On Error GoTo err

For Each cmdBar In Application.CommandBars
If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_LEFT)) Then
lngI = lngI + 1
End If
Next cmdBar
getLeftOffset = (lngI * COMMANDBAR_PIXELS)

exit_fun:
Exit Function

err:
'Assume no visible command bars:-
getLeftOffset = 0
Resume exit_fun

End Function

'---------------------------------------------------------------------------------------
' Procedure : adjustColumnWidths
' DateTime : 27/01/2003
' Author : Myke Myers [Split() replacement for Access 97 by Jamie Czernik]
' Purpose : Adjusts column widths for list boxes and combo boxes.
'---------------------------------------------------------------------------------------
Private Function adjustColumnWidths(strColumnWidths As String, sngFactor As Single) _
As String

Dim astrColumnWidths() As String
Dim strTemp As String
Dim lngI As Long
Dim lngJ As Long

'Get the column widths:-
'THIS CODE BY JAMIE CZERNIK------------------------------------------->
'Replace the Split() function as not available in Access 97:
ReDim astrColumnWidths(0)
For lngI = 1 To VBA.Len(strColumnWidths)
Select Case VBA.Mid(strColumnWidths, lngI, 1)
Case Is <> ";"
astrColumnWidths(lngJ) = astrColumnWidths(lngJ) & VBA.Mid( _
strColumnWidths, lngI, 1)
Case ";"
lngJ = lngJ + 1
ReDim Preserve astrColumnWidths(lngJ) 'Resize the array.
End Select
Next lngI
lngI = 0
'--------------------------------------------> END CODE BY JAMIE CZERNIK.
'Access 2000/2002 users can uncomment the line below and remove the split()
'replacement above.
'astrColumnWidths = Split(strColumnWidths, ";")'Available in Access 2000/2002 only
Do Until lngI > UBound(astrColumnWidths) 'Loop through all divisions
strTemp = strTemp & CSng(astrColumnWidths(lngI)) * sngFactor & ";"
lngI = lngI + 1
Loop
adjustColumnWidths = strTemp
Erase astrColumnWidths 'Destroy array.

End Function

'---------------------------------------------------------------------------------------
' Procedure : getOrigWindow
' DateTime : 27/01/2003
' Author : Jamie Czernik
' Purpose : Routine stores the original window dimensions before resizing call it
' when form loads. (before calling ResizeForm Me!).
' Call it: Form_Load()
' [More info in "Important Points" - point 5 - in help file.]
'---------------------------------------------------------------------------------------
Public Sub getOrigWindow(frm As Access.Form)

On Error Resume Next

OrigWindow.Height = frm.WindowHeight
OrigWindow.Width = frm.WindowWidth

End Sub

'---------------------------------------------------------------------------------------
' Procedure : RestoreWindow
' DateTime : 27/01/2003
' Author : Jamie Czernik
' Purpose : Routine restores the original window dimensions call it when form closes.
' Call it: Form_Close()
' [More info in "Important Points" - point 5 - in help file.]
'---------------------------------------------------------------------------------------
Public Sub RestoreWindow()

On Error Resume Next

Access.DoCmd.MoveSize , , OrigWindow.Width, OrigWindow.Height
Access.DoCmd.Save

End Sub



Na pocetku modula upisi rezoluciju u kojoj si kreirao forme.

Zatim u OnLoad forme dodaj slijedece:


Private Sub Form_Load()
ReSizeForm Me
End Sub

POZDRAV, OMER
 
Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.eqao.com



+79 Profil

icon Re: Access Baza Znanja23.09.2004. u 16:28 - pre 237 meseci
PROGRAMIRANJE: Status Bar

Ako se u programu neka neredba izvrsava dugo, treba korisniku staviti do znanja da se nesto desava i kako stvar napreduje. Najprostije resenje je da se kursor pretvori u pescani sat, komandom Docmd.HourGlass TRUE, i da je posle obavljenog posla iskljucimo sa DoCmd.Hourglass FALSE. Medjutim, to ne pokazuje progres i ako proces potraje, korisnik moze da pomisli da se racunar zaglavio.

Ako vrtimo neku petlju (Loop, For-Next, Do-While) obicno znamo gde smo, ocitavanjem brojaca. Na primer, za For i=1 to 50000 brojac i nam uvek kaze gde smo. To moze da se iskoristi i da se korisniku prikaze progress bar na dnu ekrana. To radi ovako:
Code:

Function ProgressMeter() '
'Namena: da se prikaze progres bar
Dim lngI As Long    'brojac
Dim lngMax As Long   'maximalna vrednost brojaca
lngMax = 1000000

'Moramo prvo da inicijalizujemo status bar
Call SysCmd(acSysCmdInitMeter, "Sacekajte, radim", lngMax)
'pa da ukljucimo pescani satic
DoCmd.Hourglass True 
'Ovde se nesto radi, sa brojacem
For lngI = 1 To lngMax
    'a svaku promenu brojaca moramo da UpdateMeter
    Call SysCmd(acSysCmdUpdateMeter, lngI)
    '
    'neki kod koji nesto radi
    '
Next lngI
'onda iskljucimo satic
DoCmd.Hourglass False
'pa onda bacimo poruku na ekran, da probudimo korisnika ako je zaspao
MsgBox "Gotovo!"
'i na kraju uklonimo poruku iz status bar
Call SysCmd(acSysCmdRemoveMeter)

End Function



A moze i ovako:
Code:

Function RecordsetStatusMeter()
'Namena: prikazuje progress bar dok se vrti Loop kroz rekrdset
Dim DB As DAO.Database
Dim rs As DAO.Recordset
Dim strSQl As String
Dim lngMax As Long
Dim i As Long
Dim j As Long

strSQl = "SELECT Database, Connect, Name FROM MSysObjects;"
Set DB = CurrentDb
Set rs = DB.OpenRecordset(strSQl)

DoCmd.Hourglass True

rs.MoveLast
lngMax = rs.RecordCount 'RecordCount moze da bude pogresan bez .MoveLast

rs.MoveFirst
i = 1
Call SysCmd(acSysCmdInitMeter, "Sacekajte trenutak, brojim objekte u bazi!", lngMax)

Do While Not rs.EOF
    i = i + 1 'brojac
    Call SysCmd(acSysCmdUpdateMeter, i)
    
    'kod koji nesto radi:
    Debug.Print rs!Name
    'Ovo je umetnuto da uspori malo rad
    For j = 1 To 10000000
    Next j
    rs.MoveNext
Loop

DoCmd.Hourglass False

MsgBox "Gotovo!"
Call SysCmd(acSysCmdRemoveMeter)

End Function



Obe funkcije se moraju izvrsiti iz Acces prozora, id debug se mozda ne vidi status bar. Zato je prilozen primer sa formom.
:-)
Prikačeni fajlovi
 
Odgovor na temu

mika
NBG-ML

Član broj: 55
Poruke: 640
*.privsav.co.yu.



+1 Profil

icon Re: Access Baza Znanja28.10.2004. u 14:11 - pre 236 meseci
VBA: Kako od tabele dobiti listu?

Ima slučajeva kada se od recordseta dobijenog upitom nad nekom tabelom zahteva da bude ispisan u obliku stringa, odvojen zarezima. Tipičan primer je BCC: polje u okviru email poruke.

Dakle, pretpostavimo da imamo tabelu sa email adresama:

Code:

+------+
|Emails|
+------+
|Email1|
|Email2|
|Email3|
|Email4|
+------+


Kada izvršimo sledeći kod:

Code:

   Dim rst As New ADODB.Recordset
   Dim Ispis As String
    
   rst.Open "SELECT * FROM Emails", CurrentProject.Connection, adOpenStatic, adLockReadOnly
    If rst.RecordCount > 0 Then    Ispis = rst.GetString(adClipString, , , ",")
    End If
    rst.close

    Ispis=Left(Ispis, len(Ispis)-1)

    MsgBox(Ispis)


...tada će promenljiva Ispis da ima sledeći sadržaj:

Email1, Email2, Email3, Email4


Sada ovaj string možemo postaviti u okviru Bcc polja, i proslediti email. Naravno, ovo se može generalizovati za bilo koju primenu.


Bolje 100 godina biti milioner nego nedelju dana siromašak
(c) Alan ford
 
Odgovor na temu

[es] :: Access :: Access Baza Znanja
(TOP topic, by Getsbi)
Strane: 1 2 3 4 5

[ Pregleda: 93264 | Odgovora: 82 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.