Access Baza Znanja

Code:

        cImeFajla = getTmpName()

        Set fs = CreateObject("Scripting.FileSystemObject")

        Set fileRacun = fs.CreateTextFile(cImeFajla, True)
        ...
        ...
        cRed = " << tekst koji ide na štampu >> "
        fileRacun.WriteLine (cRed)
        nRed = nRed + 1
        ...
        ...

        fileRacun.Write (Chr(12))
            
        fileRacun.Close

        cPort = "PRN"
        fs.CopyFile cImeFajla, cPort
        fs.DeleteFile cImeFajla

Code:

        fileRacun.Write (" <<< zadnji red izveštaja >>> "  & Chr(12))

Code:

Public Function Round_Z(X As Variant, U As Variant) As Variant
'Namena: zaokruzuje brojeve na bilo koju jedinicu mere
'jedinica mere moze biti decimalna ali i 'najblizih 2 cm', najblizih 15 minuta,
'bilo sta
'Iz ove funkcije izvode se i druge dve RoundUp_Z i RoundDown_Z, koje
'zaokruzju na prvu vecu ili manju okruglu vrednost jedinice mere
'Primeri:
'Zaokruzi na jednu decimalu:
'Print Round_Z(0.12345, 0.1)
' 0.1
'Zaokruzi na 3 decimale:
'Print Round_Z(0.12355, 0.001)
' 0.124
'Zaokruzi an 5 decimala:
'Print Round_Z(0.12355, 0.00001)
' 0.12355
'Zaokruzi na ceo broj
'Print Round_Z(12355.6355, 1)
'12356
'Zaokruzi na najblizi paran broj (2)
'Print Round_Z(12355.12355, 2)
'12356
'Zaokruzi na najblizi broj deljiv sa 3:
'Print Round_Z(12355.12355, 3)
'12354
'Na najblizu stotinu:
'Print Round_Z(12355.12355, 100)
'12400
'Na najblizih 0.25:
'Print Round_Z(12355.12355, 0.25)
'12355
'Print Round_Z(12355.26355, 0.25)
' 12355.25

Round_Z = Int((X + U / 2) / U) * U


End Function

Function RoundUp_Z(X As Variant, U As Variant) As Variant
'Zaokruzuje zadati broj X na prvi umnozak od U koji je veci od X
'Primeri:
'Zaokruzi na prvi veci broj deljiv sa 5
'? RoundUp_Z(12.015,5)
'15
'
RoundUp_Z = Round_Z(X + U / 2, U)
End Function

Function RoundDown_Z(X As Variant, U As Variant) As Variant
'Zaokruzuje zadati broj X na prvu manju jedinicu U
'Primeri:
'Zaokruzi na prvi manji broj deljiv sa 5
'Print RoundDown_Z(37, 5)
'35
RoundDown_Z = Round_Z(X - U / 2, U)
End Function

Code:
Public Sub ShowDrives()
    Dim fso As Object
    Set fso = CreateObject("scripting.FileSystemObject")
    Dim drv, d, strText
    
    Set drv = fso.Drives
    
    For Each d In drv
        Select Case d.DriveType
            Case 0: strText = "Nepoznato   - "
            Case 1: strText = "Floppy      - "
            Case 2: strText = "HDD         - "
            Case 3: strText = "Mrezni disk - "
            Case 4: strText = "CD-ROM      - "
            Case 5: strText = "RAM Disk    - "
        End Select
        strText = strText & d.DriveLetter & ": "
        If d.isready Then strText = strText & d.volumeName
        Debug.Print strText
    Next d
    
    Set fso = Nothing
End Sub

Code:
'****************************************************************************
'                 FUNKCIJA ZA PRETVARANJE BROJA U TEKST
'****************************************************************************
Private varCifreJedinice As Variant
Private varCifreDoDvadeset As Variant
Private varCifreDesetice As Variant
Private varCifreStotine As Variant

Public Function PretvoriBrojUTekst(ByVal dblUlazniBroj As Double) As String
   Dim strCifra As String
   Dim intDuzinaCifre As Integer
   Dim intBrojTrojki As Integer
   Dim intOstatak As Integer
   Dim intBrojac As Integer
   Dim strMINUS As String
   
   varCifreJedinice = Array("", "jedan", "dva", "tri", "èetiri", "pet", _
                             "šest", "sedam", "osam", "devet")
   
   varCifreDoDvadeset = Array("deset", "jedanaest", "dvanaest", "trinaest", _
                             "èetrnaest", "petnaest", "šesnaest", "sedamnaest", "osamnaest", "devetnaest")
   
   varCifreDesetice = Array("", "", "dvadeset", "trideset", "èetrdeset", _
                             "pedeset", "šezdeset", "sedamdeset", "osamdeset", "devedeset")
   
   varCifreStotine = Array("", "sto", "dvesto", "tristo", "èetirsto", "petsto", _
                            "šesto", "sedamsto", "osamsto", "devetsto")
   
   If dblUlazniBroj < 0 Then
      strMINUS = "-"
      dblUlazniBroj = Abs(dblUlazniBroj)
   End If
   
   PretvoriBrojUTekst = ""
   strCifra = Format(dblUlazniBroj, "###################.00")
   strCifra = Left(strCifra, Len(strCifra) - 3)
   intDuzinaCifre = Len(strCifra)
   intOstatak = intDuzinaCifre Mod 3
   intBrojTrojki = (intDuzinaCifre / 3) - ((intDuzinaCifre Mod 3) / 3)
   
   If dblUlazniBroj < 1000000000000# Then
       If intOstatak > 0 Then
           PretvoriBrojUTekst = OdrediTekstPodcifre(Left(strCifra, intOstatak), intBrojTrojki)
           strCifra = Right(strCifra, Len(strCifra) - intOstatak)
       End If
       For intBrojac = intBrojTrojki To 0 Step -1
           PretvoriBrojUTekst = PretvoriBrojUTekst & OdrediTekstPodcifre(Left(strCifra, 3), intBrojac - 1)
           If Len(strCifra) > 3 Then
               strCifra = Right(strCifra, Len(strCifra) - 3)
           End If
       Next
   Else
   End If
   
   strCifra = Format(dblUlazniBroj, "###################.00")
   strCifra = Right(strCifra, 2)
   
   If Len(PretvoriBrojUTekst) > 0 Then
       'PretvoriBrojUTekst = UCase(Left(PretvoriBrojUTekst, 1)) & Right(PretvoriBrojUTekst, Len(PretvoriBrojUTekst) - 1)
       If (Right(PretvoriBrojUTekst, 5) = "Jedan") Or (Right(PretvoriBrojUTekst, 5) = "jedan") Then
           PretvoriBrojUTekst = PretvoriBrojUTekst & " " & strCifra & "/100."
       Else
           PretvoriBrojUTekst = PretvoriBrojUTekst & " " & strCifra & "/100."
       End If
   End If
End Function

Private Function OdrediTekstPodcifre(ByVal strPodcifra As String, _
                                     intVelicina As Integer) As String
   
   Dim strTekst As String
   
   OdrediTekstPodcifre = ""
   
   If Val(strPodcifra) <> 0 Then
       strTekst = OdrediTekst(strPodcifra)
       
       Select Case intVelicina
           Case 0
           
               OdrediTekstPodcifre = strTekst
               
           Case 1
               
               'Slucaj za 11000,12000,13000,14000
               If strPodcifra = "11" Or strPodcifra = "12" Or strPodcifra = "13" Or strPodcifra = "14" Then
                  
                  OdrediTekstPodcifre = strTekst
                  OdrediTekstPodcifre = OdrediTekstPodcifre & "hiljada"
               
               Else
                  
                  'korekcija za slucaj za 2000, 22000, 32000 ....
                  If Right(strPodcifra, 1) = "2" Then
                     OdrediTekstPodcifre = Left(strTekst, Len(strTekst) - 1) & "e"
                  Else
                     OdrediTekstPodcifre = strTekst
                  End If
               
                  Select Case Right(strPodcifra, 1)
                     'Slucaj za 21000, 31000 ....
                     Case "1"
                        OdrediTekstPodcifre = Left(OdrediTekstPodcifre, Len(OdrediTekstPodcifre) - 2) & "nahiljada"
                     Case "2", "3", "4"
                        OdrediTekstPodcifre = OdrediTekstPodcifre & "hiljade"
                     Case Else
                        OdrediTekstPodcifre = OdrediTekstPodcifre & "hiljada"
                  End Select
               
                  'Slucaj za 1000
                  If Val(strPodcifra) = 1 Then
                     OdrediTekstPodcifre = "hiljadu"
                  End If
                  
               End If
           Case 2
               OdrediTekstPodcifre = strTekst & "miliona"
               If Val(strPodcifra) = 1 Then
                   OdrediTekstPodcifre = "milion"
               End If
           Case 3
               If Val(strPodcifra) = 1 Then
                   OdrediTekstPodcifre = "milijardu"
                   Exit Function
               End If
               If Val(Right(strPodcifra, 2)) > 5 And Val(Right(strPodcifra, 2)) < 21 Then
                   OdrediTekstPodcifre = strTekst & "milijardi"
                   Exit Function
               End If
               If Right(strPodcifra, 1) = "2" Then
                   OdrediTekstPodcifre = Left(strTekst, Len(strTekst) - 1) & "e"
               Else
                   OdrediTekstPodcifre = strTekst
               End If
               Select Case Right(strPodcifra, 1)
                   Case "1"
                       OdrediTekstPodcifre = Left(OdrediTekstPodcifre, Len(OdrediTekstPodcifre) - 2) & "namilijarda"
                   Case "2", "3", "4"
                       OdrediTekstPodcifre = OdrediTekstPodcifre & "milijarde"
                   Case Else
                       OdrediTekstPodcifre = OdrediTekstPodcifre & "milijardi"
               End Select
               If Val(strPodcifra) = 1 Then
                   OdrediTekstPodcifre = "milijardu"
               End If
       End Select
   End If
End Function

Private Function OdrediTekstDoSto(strPodcifra As String) As String
   OdrediTekstDoSto = ""
   
   Select Case Val(strPodcifra)
       Case 1 To 9
           OdrediTekstDoSto = varCifreJedinice(Val(strPodcifra))
       Case 10 To 19
           OdrediTekstDoSto = varCifreDoDvadeset(Val(strPodcifra) - 10)
       Case 20 To 99
           OdrediTekstDoSto = varCifreDesetice(Val(Left(strPodcifra, 1))) & varCifreJedinice(Val(Right(strPodcifra, 1)))
   End Select
End Function

Private Function OdrediTekst(strPodcifra As String) As String
   OdrediTekst = ""
   Select Case Val(strPodcifra)
       Case 1 To 99
           OdrediTekst = OdrediTekstDoSto(Val(strPodcifra))
       Case 100 To 999
           OdrediTekst = varCifreStotine(Val(Left(strPodcifra, 1))) & OdrediTekstDoSto(Val(Right(strPodcifra, 2)))
   End Select
   
End Function

Code:


application.saveastext acForm,"Imeforme","c:\folder\nekitekst.txt"

kreiranje forme iz txt fajla

application.loadfromtext acForm,"Imeforme", "c:\folder\nekitekst.txt"

Code:

Case 6
rez = rez & "ses"

Code:

'+------------------------------------
' Vraća vrednost 0 ako forma nije otvorena,
' odnosno -1 ako jeste otvorena
'+------------------------------------

Function fIsLoaded(ByVal strFormName As String) As Integer

    If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> 0 Then
        If Forms(strFormName).CurrentView <> 0 Then
            fIsLoaded = True
        End If
    End If
End Function

Code:

'+------------------------------------
' PROVERAVA DA LI JE FORMA OTVORENA
' VRAĆA VREDNOST TRUE AKO JE OTVORENA U
' Form view ILI Datasheet view MODU
'+------------------------------------
Function IsLoaded(ByVal strFormName As String) As Integer
    
    Const conObjStateClosed = 0
    Const conDesignView = 0
    
    If SysCmd(acSysCmdGetObjectState, acForm, _
    strFormName) <> conObjStateClosed Then
        If Forms(strFormName).CurrentView <> conDesignView Then
            IsLoaded = True
    End If
    End If
End Function

Code:
Const OverwriteExisting = TRUE

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objLocalFile = objFSO.GetFile("D:\FOLDER\Program_FE.mde")
dtmLocalDate = objLocalFile.DateLastModified

Set objServerFile = objFSO.GetFile("\\Server\Share\Program_FE.mde")
dtmServerDate = objServerFile.DateLastModified

If dtmLocalDate < dtmServerDate Then
    objFSO.CopyFile objServerFile.Path, objLocalFile.Path, OverwriteExisting
End If

Sub Run(ByVal sFile)
Dim shell

    Set shell = CreateObject("WScript.Shell")
    shell.Run Chr(34) & sFile & Chr(34), 1, false
    Set shell = Nothing
End Sub
Run "D:\FOLDER\Program_FE.mde"

Code:

?Diff2Dates("y", #06/01/1998#, #06/26/2002#)
4 years
?Diff2Dates("ymd", #06/01/1998#, #06/26/2002#)
4 years 25 days
?Diff2Dates("ymd", #06/01/1998#, #06/26/2002#, True)
4 years 0 months 25 days
?Diff2Dates("d", #06/01/1998#, #06/26/2002#)
1486 days

?Diff2Dates("h", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
42 hours
?Diff2Dates("hns", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
42 hours 47 minutes 33 seconds
?Diff2Dates("dhns", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
1 day 18 hours 47 minutes 33 seconds

?Diff2Dates("ymd",#12/31/1999#,#1/1/2000#)
1 day
?Diff2Dates("ymd",#1/1/2000#,#12/31/1999#)
-1 day
?Diff2Dates("ymd",#1/1/2000#,#1/2/2000#)
1 day

Code:

'***************** Code Start **************
Public Function Diff2Dates(Interval As String, Date1 As Variant, Date2 As Variant, _
Optional ShowZero As Boolean = False) As Variant
'Author:    ) Copyright 2001 Pacific Database Pty Limited
'           Graham R Seach MCP MVP [email protected]
'           Phone: +61 2 9872 9594  Fax: +61 2 9872 9593
'           This code is freeware. Enjoy...
'           (*) Amendments suggested by Douglas J. Steele MVP
'
'Description:   This function calculates the number of years,
'               months, days, hours, minutes and seconds between
'               two dates, as elapsed time.
'
'Inputs:    Interval:   Intervals to be displayed (a string)
'           Date1:      The lower date (see below)
'           Date2:      The higher date (see below)
'           ShowZero:   Boolean to select showing zero elements
'
'Outputs:   On error: Null
'           On no error: Variant containing the number of years,
'               months, days, hours, minutes & seconds between
'               the two dates, depending on the display interval
'               selected.
'           If Date1 is greater than Date2, the result will
'               be a negative value.
'           The function compensates for the lack of any intervals
'               not listed. For example, if Interval lists "m", but
'               not "y", the function adds the value of the year
'               component to the month component.
'           If ShowZero is True, and an output element is zero, it
'               is displayed. However, if ShowZero is False or
'               omitted, no zero-value elements are displayed.
'               For example, with ShowZero = False, Interval = "ym",
'               elements = 0 & 1 respectively, the output string
'               will be "1 month" - not "0 years 1 month".

On Error GoTo Err_Diff2Dates

   Dim booCalcYears As Boolean
   Dim booCalcMonths As Boolean
   Dim booCalcDays As Boolean
   Dim booCalcHours As Boolean
   Dim booCalcMinutes As Boolean
   Dim booCalcSeconds As Boolean
   Dim booSwapped As Boolean
   Dim dtTemp As Date
   Dim intCounter As Integer
   Dim lngDiffYears As Long
   Dim lngDiffMonths As Long
   Dim lngDiffDays As Long
   Dim lngDiffHours As Long
   Dim lngDiffMinutes As Long
   Dim lngDiffSeconds As Long
   Dim varTemp As Variant

   Const INTERVALS As String = "dmyhns"

'Check that Interval contains only valid characters
   Interval = LCase$(Interval)
   For intCounter = 1 To Len(Interval)
      If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
         Exit Function
      End If
   Next intCounter

'Check that valid dates have been entered
   If IsNull(Date1) Then Exit Function
   If IsNull(Date2) Then Exit Function
   If Not (IsDate(Date1)) Then Exit Function
   If Not (IsDate(Date2)) Then Exit Function

'If necessary, swap the dates, to ensure that
'Date1 is lower than Date2
   If Date1 > Date2 Then
      dtTemp = Date1
      Date1 = Date2
      Date2 = dtTemp
      booSwapped = True
   End If

   Diff2Dates = Null
   varTemp = Null

'What intervals are supplied
   booCalcYears = (InStr(1, Interval, "y") > 0)
   booCalcMonths = (InStr(1, Interval, "m") > 0)
   booCalcDays = (InStr(1, Interval, "d") > 0)
   booCalcHours = (InStr(1, Interval, "h") > 0)
   booCalcMinutes = (InStr(1, Interval, "n") > 0)
   booCalcSeconds = (InStr(1, Interval, "s") > 0)

'Get the cumulative differences
   If booCalcYears Then
      lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _
              IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
      Date1 = DateAdd("yyyy", lngDiffYears, Date1)
   End If

   If booCalcMonths Then
      lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _
              IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
      Date1 = DateAdd("m", lngDiffMonths, Date1)
   End If

   If booCalcDays Then
      lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _
              IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
      Date1 = DateAdd("d", lngDiffDays, Date1)
   End If

   If booCalcHours Then
      lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _
              IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)
      Date1 = DateAdd("h", lngDiffHours, Date1)
   End If

   If booCalcMinutes Then
      lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _
              IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
      Date1 = DateAdd("n", lngDiffMinutes, Date1)
   End If

   If booCalcSeconds Then
      lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
      Date1 = DateAdd("s", lngDiffSeconds, Date1)
   End If

   If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then
      varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " years", " year")
   End If

   If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
      If booCalcMonths Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffMonths & IIf(lngDiffMonths <> 1, " months", " month")
      End If
   End If

   If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
      If booCalcDays Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffDays & IIf(lngDiffDays <> 1, " days", " day")
      End If
   End If

   If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
      If booCalcHours Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffHours & IIf(lngDiffHours <> 1, " hours", " hour")
      End If
   End If

   If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
      If booCalcMinutes Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffMinutes & IIf(lngDiffMinutes <> 1, " minutes", " minute")
      End If
   End If

   If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
      If booCalcSeconds Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffSeconds & IIf(lngDiffSeconds <> 1, " seconds", " second")
      End If
   End If

   If booSwapped Then
      varTemp = "-" & varTemp
   End If

   Diff2Dates = Trim$(varTemp)

End_Diff2Dates:
   Exit Function

Err_Diff2Dates:
   Resume End_Diff2Dates

End Function
'************** Code End *****************

Code:
Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common]
"RespectSystemFontSmooth"=dword:00000001