XL 2016 Conversion en devise

M

marie58

XLDnaute Nouveau
Bonjour,
J'ai un tableau de reporting que je remplis en monnaie étrangère. Je dois présenter ce tableau en EUR. J'aimerai pouvoir cliquer sur un bouton et qu'une macro s'exécute afin d'avoir ce même tableau en EUR. Ce tableau me sert de base pour des graphiques et des tableaux d'indicateurs. C'est pour cette raison que j'aimerai que ce soit le même document.
Malheureusement je n'ai pas suffisamment de connaissance en vba pour faire cette manipulation. J'espère que quelqu'un pourra m'aider.
Merci d'avance
 

Pièces jointes

  • REPORTING.xlsx
    38.9 KB · Affichages: 27
Trier par date Trier par votes
cp4

cp4

XLDnaute Barbatruc
Bonjour,

Si j'ai bien compris. Cellule M1 utilisée pour ne pas convertir plusieurs fois de suite.
à tester. Code à copier dans un module standard et enregistrer fichier au format xlsm ou xlsb
VB: 
Option Explicit

Sub conversion()
Dim i As Integer, j As Integer, moné As Double
With ActiveSheet
If .Range("M1").Value = "Converti" Then
MsgBox "Monnaie déjà convertie!" & vbLf & "Fin de l'opération.", vbInformation + vbOKOnly, "CONVERTION"
Exit Sub
Else
.Range("M1") = "Converti"
moné = .Range("J2").Value
For j = 4 To 15

For i = 8 To 17
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 22 To 32
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 39 To 57
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 59 To 60
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 62 To 68
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 70 To 81
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 85 To 87
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 92 To 97
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 101 To 105
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 109 To 112
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

 i = 116
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If

Next j
MsgBox "Convertion terminée!", vbInformation + vbOKOnly, "CONVERTION DEVISE"
End If
End With
End Sub
Bonne journée.
 
Vote positif 0 Vote négatif
M

marie58

XLDnaute Nouveau
cp4 à dit:
Bonjour,

Si j'ai bien compris. Cellule M1 utilisée pour ne pas convertir plusieurs fois de suite.
à tester. Code à copier dans un module standard et enregistrer fichier au format xlsm ou xlsb
VB: 
Option Explicit

Sub conversion()
Dim i As Integer, j As Integer, moné As Double
With ActiveSheet
If .Range("M1").Value = "Converti" Then
MsgBox "Monnaie déjà convertie!" & vbLf & "Fin de l'opération.", vbInformation + vbOKOnly, "CONVERTION"
Exit Sub
Else
.Range("M1") = "Converti"
moné = .Range("J2").Value
For j = 4 To 15

For i = 8 To 17
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 22 To 32
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 39 To 57
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 59 To 60
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 62 To 68
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 70 To 81
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 85 To 87
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 92 To 97
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 101 To 105
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

For i = 109 To 112
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If
Next i

 i = 116
If IsEmpty(.Cells(i, j).Value) Then
.Cells(i, j).Value = ""
Else
.Cells(i, j).Value = .Cells(i, j).Value * moné
End If

Next j
MsgBox "Convertion terminée!", vbInformation + vbOKOnly, "CONVERTION DEVISE"
End If
End With
End Sub
Bonne journée.
Cliquez pour agrandir...
Bonjour,
Merci pour ce code.
Cela fonctionne bien. Toutefois je trouve le traitement assez long. De plus j'aimerai pouvoir le reconvertir en RON. Car ce document est complété dans la monnaie locale.
En fait l'idéal serait de pouvoir cliquer sur un bouton EUR et d'avoir le tableau en EUR, puis de recliquer sur le bouton afin de retrouver les données telles qu'elles étaient remplies en RON.
C'est peut être compliqué à réaliser ?
Merci
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Bonjour,

marie58 à dit:
Toutefois je trouve le traitement assez long. De plus j'aimerai pouvoir le reconvertir en RON. Car ce document est complété dans la monnaie locale.
Cliquez pour agrandir...
Pour le temps d’exécution: il est proportionnel au nombre de cellules à traiter.
Tu n'avais pas mentionné le taux de change, j'ai donc pris une valeur au pif.
Ce n'est pas difficile de passer d'une monnaie à l'autre. Si on a multiplié les valeurs pour passer à une autre monnaie, il suffit de diviser pour revenir aux valeurs initiales.
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour tout le fil,
Un essai simple en PJ avec :
VB: 
Sub Convertir()
    Dim L%, C%
    On Error GoTo Fin:
    If [B1] = "Value in RON" Then
        [B1] = "Value in EURO": Taux = 1 / [J2]
    Else
        [B1] = "Value in RON": Taux = [J2]
    End If
    Application.ScreenUpdating = False
    For C = 4 To 16
        For L = 6 To Range("A65500").End(xlUp).Row
            On Error Resume Next
            If Cells(L, C) <> "" Then
                If Left(Cells(L, "B"), 1) <> "%" Then
                    Cells(L, C) = Cells(L, C) * Taux
                End If
            End If
        Next L
    Next C
Fin:
End Sub
Le changement de monnaie se fait par appui sur B1.
J'ai pris par défaut 5 Lei par €. A modifier.
 

Pièces jointes

  • REPORTING.xlsm
    45.5 KB · Affichages: 7
Vote positif 0 Vote négatif

Discussions similaires

H
  • Question
Microsoft 365 Calcul d'une somme de données entre 2 dates (1 ancienne et aujourd'hui)
Réponses
13
Affichages
416
Heian911
H
H
  • Question
Microsoft 365 Automatiser la conversion des montants en fonction des devises
Réponses
6
Affichages
377
sylvanu
sylvanu
R
  • Résolu(e)
XL 2016 Somme par année en fonction d'une date de début et de fin
Réponses
4
Affichages
350
remyexcel
R
A
  • Question
XL 2019 Convertir un tableau calculé en TCD
2
Réponses
15
Affichages
672
nat54
nat54
D
  • Question
Microsoft 365 tri mobile
Réponses
5
Affichages
319
sylvanu
sylvanu
E
  • Résolu(e)
Microsoft 365 Synthèse Données en dépivotant
2
Réponses
16
Affichages
541
JFL_XLD
J
Q
  • Question
Microsoft 365 Créer un formulaire pour duplication d'onglet avec tableau
Réponses
6
Affichages
236
job75
job75
L
  • Question
XL pour MAC tableau ans perturbation des colonnes non copié
Réponses
5
Affichages
375
DJunqueira
D
Z
  • Question
XL 2016 RECHERCHEV et double liste de choix
Réponses
2
Affichages
266
zendb
Z
D
  • Question
Microsoft 365 Changement lien hypertexte en fonction nom feuille Excel
Réponses
1
Affichages
555
gbinforme
G

Membres actuellement en ligne

19 membres et 453 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 466
Messages
2 088 663
Membres
103 910
dernier inscrit
amor57