DoCmd.TransferText ' import/export/attache vers du texte 

DoCmd.TransferSpreadSheet 'import/export/attache vers une feuille de calcul 

DoCmd.TransferDatabase 'import/export/attache vers une autre base de données.

Left(Tachaine,Len(Tachaine)-1)

Function ExtraitElement(ChaineRecherche As String, Position As Long, Delim As String) As String
         
'Renvoie une chaine vide si l'extraction n'est pas possible
On Error GoTo Err_Function

Dim compteur As Long, LastPos As Long, CurPos As Long

If InStr(ChaineRecherche, Delim) = 0 Or Len(ChaineRecherche) = 0 Then Exit Function
LastPos = 1
Do
    CurPos = InStr(LastPos, ChaineRecherche, Delim)
    If CurPos = 0 Then
        If compteur = Position - 1 Then ExtraitElement = Mid(ChaineRecherche, LastPos)
        Exit Do
    Else
        compteur = compteur + 1
        If compteur = Position Then
            ExtraitElement = Mid(ChaineRecherche, LastPos, CurPos - LastPos)
            Exit Do
        End If
    End If
    LastPos = CurPos + 1
Loop While CurPos > 0
Exit Function
   
Err_Function:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Next

End Function

StrConv(String,Conversion)

MsgBox StrConv("Ceci est un essai", vbProperCase)

Public Function ReplaceT(ByVal Expression As String, _
                         ByVal Find As String, _
                         ByVal Replace As String, _
                Optional ByVal Start As Long = 1, _
                Optional ByVal Count As Long = -1, _
                Optional ByVal Compare As Integer = vbTextCompare) _
                As String
               
Dim P As Long            ' position 1er caractère à tester
Dim L As Long            ' longueur de expression
Dim f As Long            ' longueur de la chaîne à remplacer
Dim r As Long            ' longueur chaîne de remplacement

 ' argument "Start" : élimination du début de chaîne
Let L = Len(Expression)
If Start > L Then
    ' parceque "Right$" n'accepte pas 1 taille négative
    Let Expression = vbNullString
ElseIf Start > 1 Then
    ' troncature d'"Expression"
    Let Expression = Right$(Expression, L - Start + 1)
    End If

ReplaceT = Expression    ' valeur retour par défaut

 ' argument "Find" : si chaîne vide, on retourne "Expression".
If Find = vbNullString Then Exit Function
Let f = Len(Find)

Let r = Len(Replace)    ' Taille de la chaîne de remplacement
Let P = 1                ' on commence à la première position
If Count <> 0 Then
    Do
        ' La taille d'"Expression" peut varier lors de chaque
        ' remplacement (si "Find" et "Replace" sont de longueurs
        ' différentes), c'est pourquoi l'instruction suivante
        ' est située DANS la boucle.
        Let L = Len(Expression)
        ' position de la sous-chaîne à remplacer...
        Let P = InStr(P, Expression, Find, Compare)
        ' ... si elle y figure bien
        If P > 0 Then
            Let Expression = Left$(Expression, P - 1) + _
                             Replace + _
                             Right$(Expression, (L - P - f + 1))
            ' décalage 1er caractère à comparer (position trouvée
            ' + taille de la chaîne de remplacement)
            Let P = P + r
            ' Un remplacement de moins à effectuer (si "Count">0)
            ' on continue indéfiniment si "Count" < 0
            Let Count = Count - 1
            End If
        ' Si le compteur atteint zéro (cas où on voulait un nombre
        ' défini de substitutions), où s'il n'y a plus de
        ' remplacements possibles, on sort.
        Loop Until (P <= 0) Or (Count = 0)
    End If
ReplaceT = Expression        ' retour..
End Function 

Function Arrondi(ByVal Nbre As Double, ByVal Expo As Long) As Double

    If Expo < 0 Then Arrondi = Arrondi(Nbre * 10 ^ Expo, Abs(Expo))

    Arrondi = CLng(Nbre * 10 ^ Expo) / 10 ^ Expo

End Function

Clng(Nb*10^n)/10^n

Round(Nb,n)

SendKeys "{TAB}"

Dim rs as Dao.Recordset

Randomize
Set rs = CurrentDb.OpenRecordset("MATABLE", DbOpenTable)
With rs
While Not .Eof
  .Edit
  !MonChampAléat = Clng(Int((2147483647 + 2147483648 + 1) * Rnd -2147483648))
  .Update
  .Movenext
Wend
.Close
End With

Function RoundCost(ByVal Nbr As Double, _
                   Optional ByVal Expo As Long = 2, Optional ByVal NextNumSup = 5) As Double 

 'Expo is the number of desired decimals 
 'NextNumSup is the min number after the Expo decimal which result in a Roundsup for Nbr 
 'Exemple : Roundcost(0.44X) = 0.45 if X >= NextNumSUp (5 by default) 
 'Correct bug for RoundSup(0.445) = 0.44 

    If Expo < 0 Then RoundCost = RoundCost(Nbr * 10 ^ Expo, Abs(Expo)) 

    RoundCost = CLng(Nbr * 10 ^ Expo + (0.01 * (10 - NextNumSup))) / 10 ^ Expo 

End Function  

DoCmd.RunCommand  acCmdCopy  ' copier
DoCmd.RunCommand  acCmdPaste  ' coller

Me.Texte1.SetFocus
Me.Texte1.SelStart = 0
Me.Texte1.SelLength = Len(Texte1.Text)
 'le texte est sélectionné, il nous reste qu'à le copier.
DoCmd.RunCommand acCmdCopy 

Dim MaVariable As String
MaVariable = Ucase$("develoPPEZ123")

Dim MaVariable As String
MaVariable = Strconv("develoPPEZ123", vbUpperCase)

Dim MaVariable As String
MaVariable = Format("BONJOUR", "<")

Private Sub Moncontrôle_KeyPress(KeyAscii As Integer)
  KeyAscii = Asc(UCase$(Chr(KeyAscii)))
End Sub

Public Function DecimalToBinaire(DecVal As Double) As String
'Variable temporaire qui sert lors du traitement du nombre à convertir
Dim NbTmp As Double 
'Variable/Indice de boucle
Dim IndiceP as Integer 
NbTmp = DecVal
    For IndiceP = 1 To Int(Log(DecVal) / Log(2)) + 1
        DecimalToBinaire = CDbl(NbTmp Mod 2) & DecimalToBinaire
        NbTmp = CDbl(Int(NbTmp / 2))
    Next IndiceP
End Function

DecimalToBinaire(1324)

Dim N As Double
N = 2.322001
MsgBox N - Int(N)

Dim N As Double
N = -2.9
MsgBox Abs(N - Fix(N))

WorksheetFunction.Nom de la fontion

WorksheetFunction.NormSInv(0.5)

Const REQUETE As String = "raaa"
Dim q As DAO.QueryDef

Dim n As Long
DBEngine.BeginTrans
Set q = CurrentDb.QueryDefs(REQUETE)
q.Execute
If MsgBox("Vous allez insérer " & q.RecordsAffected & _
" nouveaux enregistrements." & vbCrLf & _
"Etes vous sûr de vouloir continuer ?", vbYesNo + vbQuestion, "Insertion") = vbYes Then

DBEngine.CommitTrans
Else
DBEngine.Rollback
End If

Dim oRst As DAO.Recordset 
'Ici ouverture du Recordset 
' 
' 
' 
'''''''''''''''''''''''''' 
SysCmd acSysCmdInitMeter, "Traitement", 100 'Définit la valeur maximale de la jauge. 
While Not oRst.EOF 
SysCmd acSysCmdUpdateMeter, Int(oRst.PercentPosition) 'Définit la valeur actuelle de la jauge. 
'Ici traitement sur l'enregistrement 
' 
' 
' 
oRst.MoveNext 
Wend 
SysCmd acSysCmdRemoveMeter 'Supprime la jauge d'avancement

Enum myRoundEnum
    myRoundup = -1
    myRoundDown = 1
End Enum
 
Public Function myRound(vValeur As Variant, Optional byNbDec As Byte, Optional eSens As myRoundEnum = myRoundup) As Variant
   myRound = eSens * Int(eSens * vValeur * 10 ^ byNbDec) / 10 ^ byNbDec
End Function

Sub test()
MsgBox myRound(4.333, 1, myRoundup)
MsgBox myRound(4.333, 1, myRoundDown)
End Sub

Function ReplaceArray(ByVal strExp As String, _
                      ByVal strToFind As Variant, _
                      ByVal strToReplace As Variant) As String
Dim i As Long
                      
If IsArray(strToFind) And IsArray(strToReplace) Then
    If UBound(strToFind) = UBound(strToReplace) Then
        For i = 0 To UBound(strToFind)
            strExp = Replace(strExp, strToFind(i), strToReplace(i))
        Next i
        ReplaceArray = strExp
    Else
        ReplaceArray = vbNullString
    End If
Else
    ReplaceArray = Replace(strExp, strToFind, strToReplace)
End If
End Function

replaceArray(Champ, Array("-","/"), Array("",""))

Private Sub Copier_Click()
On Error GoTo GestionErreur
 
DoCmd.RunCommand acCmdSelectRecord
DoCmd.RunCommand acCmdCopy
 
GestionErreur:
 
Select Case Err.Number
 
Case 2046  MsgBox "Action impossible pour le moment", vbExclamation + vbOKOnly, "Copier"
End Select
 
End Sub

Private Sub Coller_Click()
 
DoCmd.RunCommand acCmdSelectRecord
DoCmd.RunCommand acCmdPaste
 
End Sub

Public Function CopierPressePapier()
On Error GoTo Erreur
'Pour copier, il faut dans un premier temps sélectionner le contenu actuel
Screen.ActiveForm.Refresh 'Pour s'assurer que le contenu actuel correspond à ce qui est affiché
Screen.ActiveForm.ActiveControl.SetFocus
Screen.ActiveForm.ActiveControl.SelStart = 0
Screen.ActiveForm.ActiveControl.SelLength = Len(Screen.ActiveForm.ActiveControl.Text)
 'NB : ActiveControl.Text pour capter ce qui est affiché à l'écran
 'Copier dans le presse-papier
DoCmd.RunCommand acCmdCopy
Exit Function
Erreur:
Select Case err.Number
Case 2465  'le champ à copier est vide
MsgBox "Un champ vide ne peut être copié"
Case Else
MsgBox err.Number & "  " & err.Description
End Select
End Function

Public Function CollerPressePapier()
On Error GoTo Erreur
'Pour coller, il faut dans un premier temps sélectionner le contenu actuel
Screen.ActiveForm.ActiveControl.SetFocus
Screen.ActiveForm.ActiveControl.SelStart = 0
Screen.ActiveForm.ActiveControl.SelLength = Len(Screen.ActiveForm.ActiveControl.Text)
 'NB : ActiveControl.Text pour capter ce qui est affiché à l'écran
 'le texte est sélectionné, il ne nous reste qu'à le remplacer.
DoCmd.RunCommand acCmdPaste
Exit Function
Erreur:
MsgBox err.Number & "  " & err.Description
End Function