Vba excel convertir en nombre, appliquer un format monetaire ou pourcentage

Soyez le premier à donner votre avis sur cette source.

Snippet vu 52 288 fois - Téléchargée 21 fois

Contenu du snippet

Convertir en nombre (format standard) ou appliquer un format de type monétaire (deux décimales sans symbole) ou de type pourcentage à la plage sélectionnée (cf. saisie d'écran)

Source / Exemple :


Option Explicit

Sub CreateCommandBar()
   'Ajoute la barre de commandes "VB France"
   
   On Error Resume Next
   CommandBars("VB France").Delete
   On Error GoTo 0

   With CommandBars.Add("VB France")
'      With .Controls.Add(msoControlButton)
'         .Caption = " Source de données (ODBC) "
'         .TooltipText = .Caption
'         .OnAction = "DisplayODBCManager"
'      End With
      With .Controls.Add(msoControlButton)
         .Caption = " Afficher la calculatrice "
         .TooltipText = .Caption
'         .BeginGroup = True
         .OnAction = "ShowCalculator"
      End With
      With .Controls.Add(msoControlPopup)
         .Caption = " Macrocommandes "
         .BeginGroup = True
         With .Controls.Add(msoControlButton)
            .Caption = "Convertir en nombre (format standard)"
            .OnAction = "ConvertStrToDbl"
         End With
         With .Controls.Add(msoControlButton)
            .Caption = "Appliquer le format monétaire"
            .BeginGroup = True
            .OnAction = "ApplyCurrencyFormat"
         End With
         With .Controls.Add(msoControlButton)
            .Caption = "Appliquer le format pourcentage"
            .OnAction = "ApplyPercentageFormat"
         End With
         With .Controls.Add(msoControlButton)
            .Caption = "Corriger les dates enregistrées au format anglais"
            .BeginGroup = True
            .OnAction = "ModifyDateFormat"
         End With
      End With
      .Visible = True
   End With

End Sub

Sub ShowCalculator()
   'Affiche la calculatrice

   On Error Resume Next
   Shell ("calc.exe")
   
End Sub

Sub ConvertStrToDbl()
'Pour la plage sélectionnée : convertir en nombre (format standard)

'Variables de traitement
Dim myValue As Variant
Dim myRange As Range

   'Gestionnaire d'erreur
   On Error GoTo Except

   For Each myRange In Selection
      With myRange
         'Conditions de conversion
         If IsNumeric(.Value) Then
            If Len(Trim(.Value)) > 0 Then
               'Conversion avec format standard
               myValue = CDbl(.Value)
               .NumberFormat = "General"
               .Value = myValue
            End If
         End If
      End With
   Next

   Exit Sub
Except:
   'Boîte de dialogue : message d'erreur
   Call MsgBox(vbCr & "Erreur n° " & Err.Number & vbCr & vbCr & _
                       Err.Description & Space(6), vbCritical + vbOKOnly, " Macro de MAJ du format standard")
End Sub

Sub ApplyCurrencyFormat()
'Pour la plage sélectionnée : appliquer le format monétaire
'(*) Le format est de type natif car les paramètres régionaux
'    sont gérés de façon implicite.

'Variables de traitement
Dim myValue As Double
Dim myRange As Range

   'Gestionnaire d'erreur
   On Error GoTo Except

   For Each myRange In Selection
      With myRange
         If IsNumeric(.Value) Then
            myValue = .Value
            'Format nombre* avec deux décimales
            .NumberFormat = "#,##0.00"
            .Value = myValue
         End If
      End With
   Next

   Exit Sub
Except:
   'Boîte de dialogue : message d'erreur
   Call MsgBox(vbCr & "Erreur n° " & Err.Number & vbCr & vbCr & _
                       Err.Description & Space(6), vbCritical + vbOKOnly, " Macro de MAJ du format monétaire")

End Sub

Sub ApplyPercentageFormat()
'Pour la plage sélectionnée : appliquer le format pourcentage
'(*) Le format est de type natif car les paramètres régionaux
'    sont gérés de façon implicite.

   'Variables de traitement
   Dim myValue As Variant
   Dim myRange As Range

   'Gestionnaire d'erreur
   On Error GoTo Except
   
   For Each myRange In Selection
      With myRange
         If Right(.Value, 1) = "%" Then
            myValue = Left(.Value, Len(.Value) - 1)
            If IsNumeric(myValue) Then
               'Format pourcentage* avec deux décimales
               .NumberFormat = "#,##0.00%"
               .Value = myValue / 100
            End If
         End If
      End With
   Next

   Exit Sub
Except:
   'Boîte de dialogue : message d'erreur
   Call MsgBox(vbCr & "Erreur n° " & Err.Number & vbCr & vbCr & _
                       Err.Description & Space(6), vbCritical + vbOKOnly, " Macro de MAJ du format pourcentage")

End Sub

Sub ModifyDateFormat()
'Pour la plage sélectionnée : corriger les dates enregistrées au format anglais.
  
'Variables de traitement
Dim myDate As Date
Dim myRange As Range
Dim i As Long, j As Long
  
   'Gestionnaire d'erreur
   On Error GoTo Except
    
   'Boîte de dialogue : demande de confirmation
   i = Selection.Cells.Count
   If i = 1 Then
      If MsgBox(vbCr & "Demande de confirmation" & vbCr & vbCr & _
                       "Une seule cellule est sélectionnée. Confirmez votre sélection ?" & Space(6), vbQuestion + vbYesNo, _
                       " Macro de correction du type date") = vbNo Then Exit Sub
   End If
   
   For Each myRange In Selection
      If IsDate(myRange) Then
         With myRange
            'Condition d'inversion
            If .NumberFormat = "mm/dd/yyyy" Then
               'Mémorise la date
               myDate = .Value
               'Transforme le type du format date
               .NumberFormat = "dd/mm/yyyy"
               'Transforme la date en inversant les valeurs du mois et du jour
               .Value = CDate(Month(myDate) & "/" & Day(myDate) & "/" & Year(myDate))
               If Month(.Value) <> Month(myDate) Then j = j + 1
            End If
         End With
      End If
   Next
    
   'Boîte de dialogue : nbre de dates corrigées sur nbre de cellules vérifiées
   Call MsgBox(vbCr & "Résultat du traitement :" & vbCr & vbCr & _
                  j & " date(s) corrigée(s) sur " & i & " cellule(s) sélectionnée(s)." & Space(6), vbInformation + vbOKOnly, _
                      " Fonction de correction du type date")
       
   Exit Sub
Except:
   'Boîte de dialogue : message d'erreur
   Call MsgBox(vbCr & "Erreur n° " & Err.Number & vbCr & vbCr & _
                       Err.Description & Space(6), vbCritical + vbOKOnly, " Fonction de correction du type date")
End Sub

Conclusion :


Avec la source de correction du format date en anglais, ces macros devraient permettre de traiter les erreurs les plus couramment rencontrées.

Le mode opératoire est simple. Après voir copié le code source dans l'éditeur VB, il vous suffit d'exécuter la procédure de création de la barre d'outils. Ensuite, vous n'aurez plus qu'à personnaliser celle-ci (facultatif) en choisissant les images qui vous conviennent.

Annulez la mise en commentaire si vous souhaitez affecter la macro permettant d'afficher les sources de données (ODBC)

A voir également

Ajouter un commentaire

Commentaires

FENETRES
Messages postés
205
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009
-
'Idem pour le format pourcentage

Sub setPercentageFormat()
'Affecte le format pourcentage à la plage sélectionnée

'Variables de traitement
Dim myNumber As Double
Dim myRange As Range

'Gestionnaire d'erreur
On Error GoTo Except

For Each myRange In Selection
With myRange
If Right(.Value, 1) = "%" Then
If IsNumeric(Left(.Value, Len(.Value) - 1)) Then
myNumber = Left(.Value, Len(.Value) - 1)
.NumberFormat = "#,##0.00 %"
.Value = myNumber
End If
End If
End With
Next

Exit Sub
Except:
'Boîte de dialogue : message d'erreur
Call MsgBox(vbCr & "Erreur n° " & Err.Number & vbCr & vbCr & _
Err.Description & Space(6), vbCritical + vbOKOnly, " Macro de MAJ du format nombre")

End Sub
FENETRES
Messages postés
205
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009
-
'Plus exactement :
Sub setPercentageFormat()
'Affecte le format pourcentage à la plage sélectionnée

'Variables de traitement
Dim myNumber As Double
Dim myRange As Range

'Gestionnaire d'erreur
On Error GoTo Except

For Each myRange In Selection
With myRange
If Right(.Value, 1) = "%" Then
If IsNumeric(Left(.Value, Len(.Value) - 1)) Then
myNumber = Left(.Value, Len(.Value) - 1)
.NumberFormat = "#,##0.00 %"
.Value = myNumber
End If
ElseIf IsNumeric(.Value) Then
myNumber = .Value
.NumberFormat = "#,##0.00 %"
.Value = myNumber
End If
End With
Next

Exit Sub
Except:
'Boîte de dialogue : message d'erreur
Call MsgBox(vbCr & "Erreur n° " & Err.Number & vbCr & vbCr & _
Err.Description & Space(6), vbCritical + vbOKOnly, " Macro de MAJ du format pourcentage")

End Sub
FENETRES
Messages postés
205
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009
-
'Annule et remplace les exemples précédents en commentaire car il ne faut pas oublier de diviser par 100.

Sub setPercentageFormat()
'Affecte le format pourcentage à la plage sélectionnée

'Variables de traitement
Dim myNumber As Double
Dim myRange As Range

'Gestionnaire d'erreur
On Error GoTo Except

For Each myRange In Selection
With myRange
If Right(.Value, 1) = "%" Then
If IsNumeric(Left(.Value, Len(.Value) - 1)) Then
myNumber = Left(.Value, Len(.Value) - 1) / 100
.NumberFormat = "#,##0.00 %"
.Value = myNumber
End If
ElseIf IsNumeric(.Value) Then
myNumber = .Value / 100
.NumberFormat = "#,##0.00 %"
.Value = myNumber
End If
End With
Next

Exit Sub
Except:
'Boîte de dialogue : message d'erreur
Call MsgBox(vbCr & "Erreur n° " & Err.Number & vbCr & vbCr & _
Err.Description & Space(6), vbCritical + vbOKOnly, " Macro de MAJ du format pourcentage")

End Sub
FENETRES
Messages postés
205
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009
-
'Version finale tenant compte de la conversion d'un format nombre en pourcentage. Mille excuses pour ma distraction.

'Annule et remplace les exemples précédents en commentaire car il ne faut pas oublier de diviser ou multiplier par 100.

Sub setPercentageFormat()
'Affecte le format pourcentage à la plage sélectionnée

'Variables de traitement
Dim myNumber As Double
Dim myRange As Range

'Gestionnaire d'erreur
On Error GoTo Except

For Each myRange In Selection
With myRange
If Right(.Value, 1) = "%" Then
If IsNumeric(Left(.Value, Len(.Value) - 1)) Then
myNumber = Left(.Value, Len(.Value) - 1) / 100
.NumberFormat = "#,##0.00 %"
.Value = myNumber
End If
ElseIf IsNumeric(.Value) Then
myNumber = .Value * 100
.NumberFormat = "#,##0.00 %"
.Value = myNumber
End If
End With
Next

Exit Sub
Except:
'Boîte de dialogue : message d'erreur
Call MsgBox(vbCr & "Erreur n° " & Err.Number & vbCr & vbCr & _
Err.Description & Space(6), vbCritical + vbOKOnly, " Macro de MAJ du format pourcentage")

End Sub
FENETRES
Messages postés
205
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009
-
Proverbe du jour :
« Cent fois sur le métier, tu remettras ton ouvrage.»

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.