Office Systems Developer

 'To REQUEST a full functional sample please > Click

1. Insert a DialogBox ActiveX in your Form.

In Design View go INSERT - ActiveX CONTROL

2. Rename the control to "cdlg"

3. Paste the Code to a CLICK event of a Commad Button

CODE

    Dim strCaminho As String
    With Me.cdlg
            'Initial Directory
            .InitDir = "C:\"
            'Dialog Title
            .DialogTitle = "Localizar Arquivo"
            'Filter File Types
            .Filter = "Arquivos(*.txt)|*.txt|All Files (*.*)|*.*"
            .ShowOpen
            'Return File and Path to a Variable
            strCaminho = .FileName
    End With
    MsgBox "Path: " & strCaminho

SAMPLE

How to automate with Office Assistance?

modAssistancePropreties

Option Compare Database

' This class saves the Assistant's property settings when
' the class is initialized and restores those properties
' when the class is destroyed.
'
' PUBLIC PROPERTIES (all properties are read-only):
' AssistWithAlerts
' AssistWithHelp
' AssistWithWizards
' FeatureTips
' FileName
' GuessHelp
' HighPriorityTips
' KeyboardShortcutTips
' MouseTips
' MoveWhenInTheWay
' On
' SearchWhenProgramming
' Sounds
' TipOfDay
' Visible
'
' NOTE  The Assistant's Reduced property can be set and changed but will have
'       no visible effect on the character.
'
' SAMPLE USAGE (from a standard module):
' Function DoSomethingWithAsst()
'   Dim objAsst As clsAssistantProperties
'
'   Set objAsst = New clsAssistantProperties
'   With Application.Assistant
'       ' Insert code here to change Assistant property settings.
'   End With
'   Set objAsst = Nothing
' End Function
'
' EXAMPLE:
' You can see an example that uses this class to save and restore
' Assistant properties in the TestSaveAssistProperties procedure in
' the modAssistantProperties module.

Option Explicit
' Private class properties used to save initial Assistant
' property settings.
Private p_blnAssistWithAlerts      As Boolean
Private p_blnAssistWithHelp        As Boolean
Private p_blnAssistWithWizards     As Boolean
Private p_blnFeatureTips           As Boolean
Private p_strFileName              As String
Private p_blnGuessHelp             As Boolean
Private p_blnHighPriorityTips      As Boolean
Private p_blnKeyboardShortcutTips  As Boolean
Private p_blnMouseTips             As Boolean
Private p_blnMoveWhenInTheWay      As Boolean
Private p_blnAssistantOn           As Boolean
Private p_blnSearchWhenProgramming As Boolean
Private p_blnSounds                As Boolean
Private p_blnTipOfDay              As Boolean
Private p_blnVisible               As Boolean

Property Get AssistWithAlerts() As Boolean
    AssistWithAlerts = p_blnAssistWithAlerts
End Property

Property Get AssistWithHelp() As Boolean
    AssistWithHelp = p_blnAssistWithHelp
End Property

Property Get AssistWithWizards() As Boolean
    AssistWithWizards = p_blnAssistWithWizards
End Property

Property Get FeatureTips() As Boolean
    FeatureTips = p_blnFeatureTips
End Property

Property Get FileName() As String
    FileName = p_strFileName
End Property

Property Get GuessHelp() As Boolean
    GuessHelp = p_blnGuessHelp
End Property

Property Get HighPriorityTips() As Boolean
    HighPriorityTips = p_blnHighPriorityTips
End Property

Property Get KeyboardShortcutTips() As Boolean
    KeyboardShortcutTips = p_blnKeyboardShortcutTips
End Property

Property Get MouseTips() As Boolean
    MouseTips = p_blnMouseTips
End Property

Property Get MoveWhenInTheWay() As Boolean
    MoveWhenInTheWay = p_blnMoveWhenInTheWay
End Property

Property Get AssistantOn() As Boolean
    AssistantOn = p_blnAssistantOn
End Property

Property Get SearchWhenProgramming() As Boolean
    SearchWhenProgramming = p_blnSearchWhenProgramming
End Property

Property Get Sounds() As Boolean
    Sounds = p_blnSounds
End Property

Property Get TipOfDay() As Boolean
    TipOfDay = p_blnTipOfDay
End Property

Property Get Visible() As Boolean
    Visible = p_blnVisible
End Property

Private Sub Class_Initialize()
    ' Save the Assistant properties in effect
    ' when this class was created.
    With Application.Assistant
        p_blnAssistWithAlerts = .AssistWithAlerts
        p_blnAssistWithHelp = .AssistWithHelp
        p_blnAssistWithWizards = .AssistWithWizards
        p_blnFeatureTips = .FeatureTips
        p_strFileName = .FileName
        p_blnGuessHelp = .GuessHelp
        p_blnHighPriorityTips = .HighPriorityTips
        p_blnKeyboardShortcutTips = .KeyboardShortcutTips
        p_blnMouseTips = .MouseTips
        p_blnMoveWhenInTheWay = .MoveWhenInTheWay
        p_blnAssistantOn = .On
        p_blnSearchWhenProgramming = .SearchWhenProgramming
        p_blnSounds = .Sounds
        p_blnTipOfDay = .TipOfDay
        p_blnVisible = .Visible
    End With
End Sub

Private Sub Class_Terminate()
    ' Restore the Assistant properties to
    ' those that were set when this class
    ' was initialized.
    With Application.Assistant
        .AssistWithAlerts = p_blnAssistWithAlerts
        .AssistWithHelp = p_blnAssistWithHelp
        .AssistWithWizards = p_blnAssistWithWizards
        .FeatureTips = p_blnFeatureTips
        .FileName = p_strFileName
        .GuessHelp = p_blnGuessHelp
        .HighPriorityTips = p_blnHighPriorityTips
        .KeyboardShortcutTips = p_blnKeyboardShortcutTips
        .MouseTips = p_blnMouseTips
        .MoveWhenInTheWay = p_blnMoveWhenInTheWay
        .On = p_blnAssistantOn
        .SearchWhenProgramming = p_blnSearchWhenProgramming
        .Sounds = p_blnSounds
        .TipOfDay = p_blnTipOfDay
        .Visible = p_blnVisible
    End With
End Sub

TimerClass

Option Explicit

Private Declare Function GetTickCount& Lib "kernel32" ()
Private p_blnTimerDone      As Boolean
Private p_lngElapsedTime    As Long
Private p_lngStartTime      As Long

Property Get TimerDone() As Boolean
    TimerDone = p_blnTimerDone
End Property

Property Get ElapsedTime() As Long
    ElapsedTime = p_lngElapsedTime
End Property

Public Sub StartTimer(lngInterval As Long)
    Dim lngEndTime As Long
   
    p_blnTimerDone = False
    p_lngStartTime = GetTickCount()
    lngEndTime = p_lngStartTime + lngInterval
    Do While GetTickCount() < lngEndTime
        DoEvents
    Loop
    p_blnTimerDone = True
    p_lngElapsedTime = p_lngStartTime + GetTickCount()
End Sub

Private Sub Class_Initialize()
    p_blnTimerDone = False
    p_lngElapsedTime = 0
End Sub

modAssistantTour

Option Compare Database
Option Explicit

Sub ShowAssistant()
    ' This procedure will show the Assistant.

    With Application.Assistant
        If Not .On Then
            .On = True
        ElseIf Not .Visible Then
            .Visible = True
        End If
    End With
End Sub

Sub BalloonLabelControls()
    ' This procedure illustrates how to work
    ' with Balloon object properties and methods
    ' and how to use label controls. The procedure
    ' also shows how to use the return value of the
    ' show method to  determine the value selected
    ' by the user.
    Dim balBalloon  As Balloon
    Dim intRetVal   As Integer
    Dim strChoice   As String

    Set balBalloon = Assistant.NewBalloon
    Assistant.Visible = True
    With balBalloon
        .Button = msoButtonSetNone
        .Heading = "Balloon Object Example One"
        .Labels(1).Text = "VBA is a powerful programming language."
        .Labels(2).Text = "Office is a great development environment."
        .Labels(3).Text = "The Assistant is cool!"
        .Labels(4).Text = "Balloon objects are easy to use."
        .Text = "Select one of the following " _
            & .Labels.Count & " options:"
        ' Show the balloon.
        intRetVal = .Show
       
        ' Save the selection made by the user.
        If intRetVal > 0 Then
            strChoice = "{cf 4}" & .Labels(intRetVal).Text & "{cf 0}"
        Else
            strChoice = ""
        End If
    End With
   
    Set balBalloon = Assistant.NewBalloon
    With balBalloon
        .Text = "You selected option " & CStr(intRetVal) & ": '" _
            & strChoice & "'"
        .Show
    End With

End Sub

Sub BalloonCheckboxControls()
    ' This procedure illustrates how to work
    ' with Balloon object properties and methods
    ' and how to use checkbox controls. The procedure
    ' also shows how to use the return value of the
    ' show method to determine the value selected
    ' by the user.
    Dim balBalloon  As Balloon
    Dim intRetVal   As Integer
    Dim strChoice   As String
    Dim chkBox      As BalloonCheckbox
   
    Set balBalloon = Assistant.NewBalloon
    Assistant.Visible = True
    With balBalloon
        .Button = msoButtonSetOK
        .Heading = "Balloon Object Example Two"
        .Text = "How many of the following " _
            & .Checkboxes.Count & " statements do you agree with?"
        .Checkboxes(1).Text = "VBA is a powerful programming language."
        .Checkboxes(2).Text = "Office is a great development environment."
        .Checkboxes(3).Text = "The Assistant is cool!"
        .Checkboxes(4).Text = "Balloon objects are easy to use."
        ' Save the selection made by the user.
        intRetVal = .Show
        ' Construct the string to display to the user based on the
        ' user's selections.
        For Each chkBox In .Checkboxes
            If chkBox.Checked = True Then
                strChoice = strChoice & "{cf 4}" & chkBox.Text & "{cf 0}" & "' and '"
            End If
        Next chkBox
        ' Remove the trailing "' and '" from strChoice.
        If Len(strChoice) <> 0 Then
            strChoice = Left(strChoice, Len(strChoice) - 7)
        End If
    End With
   
    ' Create new Balloon object and display the user's choices.
    Set balBalloon = Assistant.NewBalloon
    With balBalloon
        If intRetVal > 0 Or Len(strChoice) > 0 Then
            .Text = "You selected '" & strChoice & "'."
        Else
            .Text = "You didn't make a selection."
        End If
        .Show
    End With
End Sub

Form Code

Option Compare Database

Option Explicit

' Create a global object variable used to store the original
' Office Assistant's properties when the form opens.
Public gclsAsstProps As clsAssistantProperties

' Location of Assistant files.
Const ASSISTANT_PATH As String = "c:\program files\microsoft office\office\"

Private Sub cboAnimations_AfterUpdate()
    If Assistant.Visible = False Then
        Call ShowAssistant
    End If
    Assistant.Animation = Me!cboAnimations.Value
End Sub

Private Sub cboCharacter_AfterUpdate()
    With Assistant
        If InStr(.FileName, cboCharacter.Value) = 0 Then
            .Animation = msoAnimationDisappear
            ' Call the Wait procedure to give the
            ' animation 1 second to finish.
            Wait
            .FileName = ASSISTANT_PATH & Me.cboCharacter.Value
        End If
    End With
    UpdateCaption Me!lblFileName
    ShowAssistant
End Sub

Private Sub cmdShowBalloon_Click()
    ' This procedure is called from the Show Balloon
    ' button on the View Balloon tab of the Assistant form.
    Dim balBalloon      As Balloon
    Dim intRetVal       As Integer
    Dim intI            As Integer
    Dim strChoice       As String
    Dim blnAsstVisible  As Boolean
       
    On Error GoTo ShowBalloon_Err
   
    ' Set Balloon object variable.
    Set balBalloon = Assistant.NewBalloon
   
    ' Make sure the Assistant is visible.
    If Assistant.Visible = False Then
        Call ShowAssistant
    End If
   
    ' Determine the button style selected by the user.
    Select Case Me!ctlOptionStyle
        Case 1      ' Label button style.
            With balBalloon
                .Button = msoButtonSetNone
                .Heading = Me!txtBalloonHeading
                .Labels(1).Text = Me!txtOption1
                .Labels(2).Text = Me!txtOption2
                .Labels(3).Text = Me!txtOption3
                .Labels(4).Text = Me!txtOption4
                .Text = "Which of the following " _
                    & .Labels.Count & " choices apply to you?"
                ' Save the selection made by the user.
                intRetVal = .Show
                If intRetVal > 0 Then
                    strChoice = "{cf 4}" & .Labels(intRetVal).Text & "{cf 0}"
                Else
                    strChoice = ""
                End If
            End With
        Case 2      ' Check box button style.
            With balBalloon
                .Button = msoButtonSetOK
                .Heading = Me!txtBalloonHeading
                .Checkboxes(1).Text = Me!txtOption1
                .Checkboxes(2).Text = Me!txtOption2
                .Checkboxes(3).Text = Me!txtOption3
                .Checkboxes(4).Text = Me!txtOption4
                .Text = "Which of the following " _
                    & .Checkboxes.Count & " choices apply to you?"
                ' Save the selection made by the user.
                intRetVal = .Show
                ' Construct the string to display to the user based on the
                ' user's selections.
                For intI = 1 To .Checkboxes.Count
                    If .Checkboxes(intI).Checked = True Then
                        strChoice = strChoice & "{cf 4}" & .Checkboxes(intI).Text & "{cf 0}" & "' and '"
                    End If
                Next intI
                ' Remove the trailing "' and '" from strChoice.
                If Len(strChoice) <> 0 Then
                    strChoice = Left(strChoice, Len(strChoice) - 7)
                End If
            End With
    End Select
   
    ' Create new Balloon object and display the user's choices.
    Set balBalloon = Assistant.NewBalloon
        With balBalloon
            If intRetVal > 0 Or Len(strChoice) > 0 Then
                .Text = "You selected '" & strChoice & "'"
            Else
                .Text = "You didn't make a selection."
            End If
        .Show
        End With

ShowBalloon_End:
    Exit Sub
ShowBalloon_Err:
    MsgBox Err.Description
    Resume ShowBalloon_End
End Sub

Private Sub Form_Open(Cancel As Integer)
    ' This procedure locates Assistant files and
    ' fills a combo box with the names of the
    ' Assistant files on this system.
    Dim strCharacterFiles   As String
    Dim intCurrFile         As Integer
    Dim intDirPath          As Integer
   
    Set gclsAsstProps = New clsAssistantProperties
   
    ' Use FileSearch Object to load Assistant combo box.
    With Application.FileSearch
        .NewSearch
        .FileName = "*.acs"
        .LookIn = ASSISTANT_PATH
        intDirPath = Len(ASSISTANT_PATH)
        .SearchSubFolders = False
        If .Execute > 0 Then
            For intCurrFile = 1 To .FoundFiles.Count
                strCharacterFiles = strCharacterFiles & Mid$(.FoundFiles(intCurrFile), intDirPath + 1) & ";"
            Next intCurrFile
            strCharacterFiles = Left(strCharacterFiles, Len(strCharacterFiles) - 1)
        Else
            MsgBox "No Assistant files (*.acs) located in the '" & .LookIn & "' directory."
        End If
        With Me!cboCharacter
            .RowSource = strCharacterFiles
            .Value = Mid$(Assistant.FileName, intDirPath + 1)
        End With
        UpdateCaption Me!lblFileName
    End With
   
    ShowAssistant
   
    With Assistant
        .Left = 500
        .Top = 200
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' Restore the Assistant properties to those
    ' that were in effect when this form was
    ' loaded.
    Set gclsAsstProps = Nothing
End Sub
Sub UpdateCaption(ctl As Control)
    ' Update the label caption using the selected assistant name.
    ctl.Caption = "Animation for: '" & Assistant.Item & "'"
End Sub
Sub Wait(Optional lngDuration As Long = 1000)
    ' This procedure is called after an Assistant Animation
    ' property setting is specified and is designed to give the
    ' animation time to complete. The procedure waits the number
    ' of milliseconds sepecified in the lngDuration argument.
    ' The default is 1 second.
    Dim clsTimer As TimerClass
   
    Set clsTimer = New TimerClass
   
    With clsTimer
        .StartTimer lngDuration
        Do Until .TimerDone = True
            DoEvents
        Loop
    End With
   
    Set clsTimer = Nothing
End Sub

How to Spell Months by VBA Code and SQL?

'(c) 2005 João Tito Lívio
'This code can only be use as a part of an Application and could not be sell

 'To REQUEST a full functional sample please > Click 

VBA

MsgBox (Format(Now(), "mmmm"))
MsgBox ("Month: " & Format(Now(), "mmmm"))
MsgBox ("Month: " & Format(#1/1/2005#, "mmmm"))

SQL

SELECT Table1.Data, "This is month: " & Format([Data];"mmmm") AS strConvertion
FROM Table1;

How to Disable (F11 key) Shortcut to database Window?

'(c) 2005 João Tito Lívio 
'This code can only be use as a part of an Application and could not be sell

'TIP: Use code in the Autoexec Macro

'USAGE: If DisableSpecialKeys = True then MsgBox"OK"

 'To REQUEST a full functional sample please > Click 

Option Compare Database

Public Function DisableSpecialKeys() As Boolean
On Error GoTo Err_DisableSpecialKeys

Dim db As Database
Dim Prop As Property
Const conPropNotFound = 3270

Set db = CurrentDb()
db.Properties("AllowSpecialKeys") = False
Set db = Nothing

DisableSpecialKeys = True

Exit_DisableSpecialKeys:
    Exit Function

Err_DisableSpecialKeys:
    If Err = conPropNotFound Then
        'If the property doesn't exist, create it
        Set Prop = db.CreateProperty("AllowSpecialKeys", dbBoolean, True)
        db.Properties.Append Prop
        Resume Next
    Else
        MsgBox "Disable did not Work!!"
        DisableSpecialKeys = False
        Resume Exit_DisableSpecialKeys
    End If

End Function

How to Spell numbers to Euros using API?

'(c) 2003 João Tito Lívio 
'This code can only be use as a part of an Application and could not be sell

 'To REQUEST a full functional sample please > Click 

   
This function originally was developed as the name indicates to convert numbers for extensive, 
even so it can be adapted for currency but with some limitations, or either, the used text for number 1.000.000.000, will have to be modified 
for ("A thousand million euros") And 1.000.000.000.000= ("1 million of millions Euros") Since we are in Europe and not in the United States. 
 

Option Compare Database
 

Private Declare Function GetLocaleInfo& _
Lib "kernel32" Alias "GetLocaleInfoA" ( _
  ByVal Locale As Long, _
  ByVal LCType As Long, _
  ByVal lpLCData As String, _
  ByVal cchData As Long)


Private Const LOCALE_USER_DEFAULT& = &H400
Private Const LOCALE_SDECIMAL& = &HE
Private Const LOCALE_SCURRENCY& = &H14
Private Const LOCALE_SMONDECIMALSEP& = &H16

Public Enum enmFormat
  Maiusculas
  Minusculas
  PrimeiraMaiuscula
End Enum

Private arrGrupo() As String
'2 Dimensions
'1º -> [0]=Numeric value from group; [1]=extenso
'2ª -> Counter

Private Const e = "e "
Private Const Virgula = ", "

Private Const ZERO = "Zero "
Private Const um = "Um "
Private Const DOIS = "Dois "
Private Const TRES = "Três "
Private Const QUATRO = "Quatro "
Private Const CINCO = "Cinco "
Private Const SEIS = "Seis "
Private Const SETE = "Sete "
Private Const OITO = "Oito "
Private Const NOVE = "Nove "
Private Const DEZ = "Dez "

Private Const ONZE = "Onze "
Private Const DOZE = "Doze "
Private Const TREZE = "Treze "
Private Const CATORZE = "Catorze "
Private Const QUINZE = "Quinze "
Private Const DEZASSEIS = "Dezasseis "
Private Const DEZASSETE = "Dezassete "
Private Const DEZOITO = "Dezoito "
Private Const DEZANOVE = "Dezanove "

Private Const VINTE = "Vinte "
Private Const TRINTA = "Trinta "
Private Const QUARENTA = "Quarenta "
Private Const CINQUENTA = "Cinquenta "
Private Const SESSENTA = "Sessenta "
Private Const SETENTA = "Setenta "
Private Const OITENTA = "Oitenta "
Private Const NOVENTA = "Noventa "
Private Const CEM = "Cem "
Private Const CENTO = "Cento "
Private Const DUZENTOS = "Duzentos "
Private Const TREZENTOS = "Trezentos "
Private Const QUATROCENTOS = "Quatrocentos "
Private Const QUINHENTOS = "Quinhentos "
Private Const SEISCENTOS = "Seiscentos "
Private Const SETECENTOS = "Setecentos "
Private Const OITOCENTOS = "Oitocentos "
Private Const NOVECENTOS = "Novecentos "
Private Const MIL = "Mil "

Private Const MILHAO = "Milhão "
Private Const MILHOES = "Milhões "
Private Const BILIAO = "Bilião "
Private Const BILIOES = "Biliões "

Private strUnidades(9) As String
Private strTeens(99) As String
Private strDezenas(9) As String
Private strCentenas(9) As String
Private strMilhares(9) As String

Private mstrDecSep As String * 1
Private mstrDefaultErrorMsgOverflow As String
Private Const ERR_OVERF = "Overflow"

'Singular
Private mstrDefaultSufixoInteiro1 As String
Private Const SUF_INT1 = "Euro "
Private mstrDefaultSufixoDecimal1 As String
Private Const SUF_DEC1 = "Centimo "

'Plural
Private mstrDefaultSufixoInteiro2 As String
Private Const SUF_INT2 = "Euros "
Private mstrDefaultSufixoDecimal2 As String
Private Const SUF_DEC2 = "Centimos "

Private Const MAX_NUMBER As Double = 999999999999.99

Private Sub msEncher()

'strUnidades(0) = ZERO ' Must be an empty string
strUnidades(1) = um
strUnidades(2) = DOIS
strUnidades(3) = TRES
strUnidades(4) = QUATRO
strUnidades(5) = CINCO
strUnidades(6) = SEIS
strUnidades(7) = SETE
strUnidades(8) = OITO
strUnidades(9) = NOVE

'strTeens(0) = ZERO ' Must be an empty string
strTeens(1) = um
strTeens(2) = DOIS
strTeens(3) = TRES
strTeens(4) = QUATRO
strTeens(5) = CINCO
strTeens(6) = SEIS
strTeens(7) = SETE
strTeens(8) = OITO
strTeens(9) = NOVE
strTeens(10) = DEZ
strTeens(11) = ONZE
strTeens(12) = DOZE
strTeens(13) = TREZE
strTeens(14) = CATORZE
strTeens(15) = QUINZE
strTeens(16) = DEZASSEIS
strTeens(17) = DEZASSETE
strTeens(18) = DEZOITO
strTeens(19) = DEZANOVE

strDezenas(0) = ""
strDezenas(1) = "-"
strDezenas(2) = VINTE
strDezenas(3) = TRINTA
strDezenas(4) = QUARENTA
strDezenas(5) = CINQUENTA
strDezenas(6) = SESSENTA
strDezenas(7) = SETENTA
strDezenas(8) = OITENTA
strDezenas(9) = NOVENTA

strCentenas(0) = ""
strCentenas(1) = CEM
strCentenas(2) = DUZENTOS
strCentenas(3) = TREZENTOS
strCentenas(4) = QUATROCENTOS
strCentenas(5) = QUINHENTOS
strCentenas(6) = SEISCENTOS
strCentenas(7) = SETECENTOS
strCentenas(8) = OITOCENTOS
strCentenas(9) = NOVECENTOS


End Sub

Private Function mfTraduzir(xGrupo%, xstr$) As String
'Traslate 3 numbers group
'(right pad)
On Error GoTo erro
Dim blnAnteriorRedondo As Boolean   'quando grupo anterior = '*00'
Dim ret$, xlen%
xlen = Len(xstr$)
Dim Unid As Byte, strUnid$
Dim Teen As Byte, strTeen$
Dim Dezena As Byte, strDezn$
Dim Centena As Byte, strCent$

mstrDefaultSufixoInteiro1 = SUF_INT1
mstrDefaultSufixoDecimal1 = SUF_DEC1
mstrDefaultSufixoInteiro2 = SUF_INT2
mstrDefaultSufixoDecimal2 = SUF_DEC2


  Unid = CByte(Right(xstr$, 1))
  Teen = CByte(Right(xstr$, 2))
  Dezena = CByte(Mid(xstr$, xlen - 1, 1))
  Centena = CByte(Mid(xstr$, xlen - 2, 1))
If Centena Then
strCent = IIf(Teen = 0, strCentenas(Centena), _
  IIf(Centena = 1, CENTO, strCentenas(Centena)) & _
  IIf(Teen = 0, "", e)) & " "
End If

strDezn = IIf(Teen > 19, strDezenas(Dezena), strTeens(Teen)) & _
  IIf(Unid And Teen > 19, e, "")

strUnid = IIf(Teen > 19, strUnidades(Unid), "")

ret = strCent & strDezn & strUnid

  Dim strNumAnterior$, strExtAnterior$
  
  On Error Resume Next
  strNumAnterior = arrGrupo(0, xGrupo - 1) 'grupo anterior
  strExtAnterior = arrGrupo(1, xGrupo - 1)
  blnAnteriorRedondo = Val(Right(strNumAnterior, 2)) = 0
  On Error GoTo erro
  
  Select Case xGrupo
    Case 0                '   000
    
    Case 1 '000xxx
      
      arrGrupo(1, xGrupo - 1) = _
      IIf(blnAnteriorRedondo, _
      IIf(Val(strNumAnterior) = 0, "", e) & strExtAnterior, _
      e & strExtAnterior)
      
    ret = IIf(Val(xstr) = 0, "", _
      IIf(Val(xstr) = 1, MIL, ret & MIL))
      
    Case 2 '000xxxxxx
      arrGrupo(1, xGrupo - 1) = _
      IIf(Val(strNumAnterior) = 0 And Val(arrGrupo(0, xGrupo - 2)) = 0, _
        "", IIf(Val(strNumAnterior) > 0, IIf(Val(arrGrupo(0, xGrupo - 2)) = 0, _
        e, Virgula), "") & strExtAnterior)

    ret = IIf(Val(xstr) = 0, "", _
      IIf(Val(xstr) = 1, ret & MILHAO, ret & MILHOES))

    Case 3 ' 000xxxxxxxxx
      arrGrupo(1, xGrupo - 1) = _
      IIf(Val(strNumAnterior) = 0 And Val(arrGrupo(0, xGrupo - 2)) = 0 _
      And Val(arrGrupo(0, xGrupo - 3)) = 0, _
        "", IIf(Val(strNumAnterior) = 0, "", _
        IIf(Val(arrGrupo(0, xGrupo - 2)) = 0, e, Virgula)) & strExtAnterior)
      
    ret = IIf(Val(xstr) = 0, "", _
      IIf(Val(xstr) = 1, ret & BILIAO, ret & BILIOES))
  End Select

mfTraduzir = Trim(ret) & " "
Exit Function
erro:
  If Err = 5 Then
  Resume Next
  Else
  MsgBox Err & vbCrLf & Err.Description
  Resume Next
  End If
End Function
Private Sub Class_Initialize()
    msEncher
    mstrDecSep = mfstrGetDecimalSep
    mstrDefaultErrorMsgOverflow = ERR_OVERF
End Sub


Public Function gfGet( _
  ByVal dblX As Double, _
  Optional xmoeda As String, _
  Optional ByVal lngFormat As Long = PrimeiraMaiuscula) As String
On Error GoTo erro

Static mblnInitialized As Boolean

If Not mblnInitialized Then
    msEncher
    mstrDecSep = mfstrGetDecimalSep
    mstrDefaultErrorMsgOverflow = ERR_OVERF
    mblnInitialized = True
End If


If dblX > MAX_NUMBER Then
  gfGet = mstrDefaultErrorMsgOverflow
  Exit Function
End If

Dim strNeg$

If dblX < 0 Then
  dblX = dblX * -1
  strNeg = "Menos "
End If

'Por defeito fica em escudos
If xmoeda = "" Then
    xmoeda = "PTE"
End If
'

dblX = Format(dblX, ".00")
Dim strInteiro$, strDecimal$

  msGetParts CStr(dblX), strInteiro, strDecimal

  Dim ret$, retInt$, retDec$
    If strInteiro <> "" Then
      If CDbl(strInteiro) > 0 Then
        retInt = mfstrProcessar(strInteiro)
      Else
        retInt = ZERO
      End If
      retInt = retInt & IIf(CDbl(strInteiro) = 1, mstrDefaultSufixoInteiro1, mstrDefaultSufixoInteiro2)
    End If
       
    If strDecimal <> "" Then
      If CDbl(strInteiro) = 0 Then
        retInt = ""
      Else
        retInt = retInt & e
      End If
      retDec = mfstrProcessar(strDecimal)
      retDec = retDec & IIf(CDbl(strDecimal) = 1, mstrDefaultSufixoDecimal1, mstrDefaultSufixoDecimal2)
    End If
    
    
    ret = retInt & retDec
  
  gfGet = strNeg & IIf(lngFormat = Minusculas, LCase(ret), _
                    IIf(lngFormat = Maiusculas, UCase(ret), _
                    ret))
  
Exit Function
erro:
  gfGet = Err.Number & "; " & Err.Description
End Function

Private Sub msGetParts(ByVal strAll$, ByRef strInt$, ByRef strDec$)
  Dim intVirgLoc%
  intVirgLoc = InStr(1, strAll, mstrDecSep)
    
    If intVirgLoc > 0 Then
      strInt = Mid(strAll, 1, intVirgLoc% - 1)
      strDec = Mid(strAll, intVirgLoc% + 1)
        If Len(strDec) = 1 Then strDec = strDec & "0"
    Else
      strInt = strAll$
      strDec = ""
    End If
    
End Sub

Private Function mfstrProcessar(strPart$) As String
Dim lp%, xlen%, cnt%, ret$, buf$
Dim xstart%
xlen = Len(strPart$)
  For lp = 1 To xlen Step 3
  
  'Send numbers in 3 didit groups
  xstart = xlen - (3 * cnt)
  xstart = IIf(xstart <= 0, 1, xstart)
  buf = Right(Left(strPart$, xstart), 3)
  ReDim Preserve arrGrupo(1, cnt)
  arrGrupo(0, cnt) = CDbl(buf)
  arrGrupo(1, cnt) = mfTraduzir(cnt, Format(buf, "000"))
    cnt = cnt + 1
  Next
  
  'Spell joining the translated numbers
  Dim xtemp As String
  For lp = UBound(arrGrupo, 2) To 0 Step -1
    xtemp = xtemp & arrGrupo(1, lp)
  Next
  
  'Cut Fake spaces
  Dim red1$, inred1%, red2$, inred2%
  Dim tempA$, tempB$
  inred1 = 999: inred2 = 999

  red1 = "  ": red2 = " ,"


  Do Until inred1 + inred2 = 0

    inred1 = InStr(1, xtemp, red1)
    inred2 = InStr(1, xtemp, red2)

    If inred1 > 0 Then
      xtemp = Trim(Left(xtemp, inred1) & Right(xtemp, Len(xtemp) - (inred1 + 1)))
    End If

    If inred2 > 0 Then Mid(xtemp, inred2, 2) = ", "

  Loop
  ret = xtemp & IIf(Right(xtemp, 1) <> " ", " ", "")
  mfstrProcessar = ret

End Function

Private Function mfstrGetDecimalSep() As String
Dim ret&
Dim buf As String * 10
ret = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SDECIMAL, buf, Len(buf))
mfstrGetDecimalSep = Left(buf, InStr(1, buf, vbNullChar) - 1)
End Function


'      //////////////     PROPS     /////////////////////

Public Property Get DecimalSep() As String
  DecimalSep = mstrDecSep
End Property
Public Property Let DecimalSep(x As String)
  mstrDecSep = x
End Property
Public Property Get OverflowMsg() As String
  OverflowMsg = mstrDefaultErrorMsgOverflow
End Property
Public Property Let OverflowMsg(x As String)
  mstrDefaultErrorMsgOverflow = x
End Property
Public Property Get MaxNumber() As Double
  MaxNumber = MAX_NUMBER
End Property
Public Property Get SufixoInteiroSingular() As String
  SufixoInteiroSingular = mstrDefaultSufixoInteiro1
End Property
Public Property Let SufixoInteiroSingular(x As String)
  mstrDefaultSufixoInteiro1 = x & IIf(Right(x, 1) = "", "", " ")
End Property
Public Property Get SufixoInteiroPlural() As String
  SufixoInteiroPlural = mstrDefaultSufixoInteiro2
End Property
Public Property Let SufixoInteiroPlural(x As String)
  mstrDefaultSufixoInteiro2 = x & IIf(Right(x, 1) = "", "", " ")
End Property
Public Property Get SufixoDecimalSingular() As String
  SufixoDecimalSingular = mstrDefaultSufixoDecimal1
End Property
Public Property Let SufixoDecimalSingular(x As String)
  mstrDefaultSufixoDecimal1 = x & IIf(Right(x, 1) = "", "", " ")
End Property
Public Property Get SufixoDecimalPlural() As String
  SufixoDecimalPlural = mstrDefaultSufixoDecimal2
End Property
Public Property Let SufixoDecimalPlural(x As String)
  mstrDefaultSufixoDecimal2 = x & IIf(Right(x, 1) = "", "", " ")
End Property