|
begin process at 2008 07 21 00:39:22
Derniers logiciels
|
Trouver une ressource (Nouvelle version du moteur, plus rapide & pertinent, essayez le !)
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
VBA EXCEL CONVERTIR EN NOMBRE, APPLIQUER UN FORMAT MONETAIRE OU POURCENTAGE
Information sur la source
Description
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
- 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
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)
Historique
- 31 janvier 2007 12:10:01 :
- Ajout du format pourcentage
- 01 février 2007 10:13:20 :
- Selon le type de nombre (entier ou réel) le format nombre comprend zéro ou deux décimales(naturellement, il est possible de généraliser à n décimales).
- 01 février 2007 17:02:03 :
- Ajout du format standard afin de le dissocier des formats spécifiques.
- 01 février 2007 17:23:52 :
- Pour le format standard, la variable " myValue " doit être un " Variant " !
- 02 février 2007 16:51:07 :
- Nouvelle saisie d'écran
- 05 février 2007 10:39:15 :
- MAJ des mots clés
- 05 février 2007 10:50:51 :
- format monétaire avec séparateur des milliers
- 05 février 2007 11:40:40 :
- Format général avec conversion conditionnelle en nombre
- 05 février 2007 11:49:17 :
- MAJ commentaires
- 05 février 2007 12:12:41 :
- Format standard : ajout de la condition Len(.Value) > 0 (pas de conversion d'une chaîne vide).
- 05 février 2007 14:06:36 :
- Séparation du format standard (convertir en nombre) des formats spécifiques (formats monéraire et pourcentage)
- 05 février 2007 15:04:55 :
- Nouvelle saisie d'écran (menus avec nouveau groupe)
- 06 février 2007 09:37:47 :
- Simplification pédagogique du code source de la méthode d'application d'un format pourcentage.
- 06 février 2007 11:22:00 :
- La mise à jour mineure précédente (ApplyPercentageFormat) oblige à modifier le type de " MyValue " en variant sinon l'affectation retourne une erreur d'incompatibilité de type.
- 06 février 2007 13:50:49 :
- MAJ commentaires
- 15 février 2007 14:30:03 :
- Prise en compte des options régionales.
Il y a toujours un petit malin pour ne pas faire comme tout le monde !
- 16 février 2007 16:09:46 :
- La dernière mise à jour était incorrecte.
Les paramètres régionaux sont gérés de façon implicite par le format natif de nombre.
- 16 février 2007 16:52:21 :
- Erreur de manip.
- 16 février 2007 16:58:11 :
- Jamais deux sans trois
- 20 février 2007 11:56:35 :
- Ajout de commentaires dans le code source (format natif)
- 02 mars 2007 13:07:41 :
- Ajout de la procédure de création de la barre d'outils
- 02 mars 2007 13:51:25 :
- Mode opératoire
- 02 mars 2007 18:07:57 :
- Nouvelle saisie d'écran
- 05 mars 2007 11:17:05 :
- Ajout d'un bouton pour afficher la calculatrice (raccourci).
Sources de la même categorie
Commentaires
Discussions en rapport avec ce code source
|
Téléchargements
Logiciels à télécharger sur le même thème :
|
|