Changement de devise automatique

Bonjour à toutes et à tous,

étant débutant en VBA, on m'a conseillé de réaliser une petite macro de changement de devise que voici :

Sub essai()

'Activation de la feuille "tableau"
    Dim wb As Workbook
    Dim data As Worksheet
    Dim tbl As Worksheet

    Set wb = ThisWorkbook
    Set data = wb.Sheets("data http")
    Set tbl = wb.Sheets("tableau")

' définition de AMT = montant à transformer
    Dim MONTANT As Currency
' définition de DDB = devise de base
    Dim DEVISEDEBASE As String
' définition de DDS = devise de sortie
    Dim DEVISEDESORTIE As String

    Dim lien As String

    Dim NBRCARAC As Currency

' donner la valeur de B2
        MONTANT = tbl.Range("B2")
' donner la valeur de C2
        DEVISEDEBASE = tbl.Range("C2")
'donner la valeur de D2
        DEVISEDESORTIE = tbl.Range("D2")

        lien = "http://www.xe.com/fr/currencyconverter/convert/?Amount="
            lien = lien & MONTANT & "&From=" & DEVISEDEBASE & "&To=" & DEVISEDESORTIE

    'MsgBox (lien)

    data.Range("A1:F250").Clear

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;lien" _
        , Destination:=Range("$A$33"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False

    End With

    With tbl.Range("A33:F250").Cut(data.Range("A1"))
    End With

    With tbl.Columns("A:F").Select
        Selection.ColumnWidth = 16
    End With

    With data.Range("A1:F250")
        Set c = .Find(What:="" & MONTANT & " " & DEVISEDEBASE & " =")
        If Not c Is Nothing Then
            tbl.Range("E2") = c
        End If
    End With

End Sub

Pour expliquer sommairement la macro, il faut rentrer un montant à changer, une devise d'entrée et une devise de sortie, avec un URL dynamique en fonction des paramètres

Mais lorsque j’exécute la macro une "Erreur d’exécution '1004' : l'adresse de ce site n'est pas valide.." apparaît, et c'est la ligne ".Refresh BackgroundQuery:=False" qui semble poser problème,

pourtant j'ai vérifié le lien qui coïncide avec le lien que me donnerais le site internet..

Tournant en rond depuis quelques jours, je m'adresse à vous dans l'espoir d'être aidé..

Merci d'avance

Plus simple ...

Sub Essai()
Dim URL$

    URL = "http://www.xe.com/fr/currencyconverter/convert/?Amount="
    URL = URL & Range("B2").Value & "&From=" & Range("C2").Value & "&To=" & Range("D2").Value

    DoEvents
    On Error Resume Next
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .Send
        If .Status = 200 Then
            Range("E2") = Split(Split(.responseText, "<span class='uccResultAmount'>")(1), "</span>")(0)
        End If
    End With

End Sub

Merci beaucoup

Bonjour,

Je reviens vers vous car je suis à nouveau bloqué.

Je souhaiterais que la devise du montant final s'affiche et s'adapte automatiquement en fonction de la devise de sortie demandé, sachant que dans le format monétaire, tous les symboles de devises y sont répertoriés.

J'ai déjà essayé mais étant donné que la devise de sortie est demandé en devises ISO à savoir "EUR" pour l'euro ou bien "AED" pour le Dirham des Émirats arabes unis, je n'y arrive pas.

(c'est la macro essai, les autres ne sont que des "sauvegardes")

Merci d'avance

Bonjour,

Justement, j'avais élargi les possibilités comme suit :

est-ce que cela répond ?

Il y a 2 menus déroulants. J'ai repris toutes les devises présentes sur ce site.

bartabanx a écrit :

Je souhaiterais que la devise du montant final s'affiche et s'adapte automatiquement en fonction de la devise de sortie demandé, sachant que dans le format monétaire, tous les symboles de devises y sont répertoriés.

ok je regarde, je n'avais pas compris tout de suite la question !

Tout d'abord merci pour votre réponse rapide !

Votre présentation correspond en effet plus à ce que je recherchais mais comme je l'avais mis dans le fichier, il faudrait que l'on puisse remplir plusieurs ligne, avec possibilité de laisser des champs libre entre les lignes et afficher le symbole de la monnaie dans les champs "Montant final" et "Inverse".

Au passage, il y a un commentaire sur le site : <!-- WARNING: Automated extraction of rates is prohibited under the Terms of Use. -->

Bon, j'ai dû batailler avec les blancs insécables ... et du coup corriger une erreur qui existait !

IL faut que tu termines les formats de l'onglet devises (et tu me le repasseras ensuite STP)

J'ai renseigné toutes les monnaies de la norme ISO 4217, je n'ai pas encore adapté le format à toutes les monnaies, mais les principales y sont.

Le fichier joint n'est donc pas complet, je le compléterais cette semaine et le posterais.

Merci encore et bonne fête de fin d'année !!

Bonjour,

ci-joint le fichier avec toutes les devises que Excel 2010 contient, ne disposant pas de la version 2016, je ne peux pas renseigné correctement les devises restantes..

Bonne année à tous,

Cdt