[Calc] Saisie de donnée sur Internet

[Pyanepsion]

J'ai la macro suivante qui fonctionne très bien sur Excel. Elle permet de saisir des données sur le site de MSN. Quel est son équivalent Calc? Merci à tous.

Code : Tout sélectionner

Option Explicit
Dim C, K&, X, Y&, Plage As Range
Public Sub Menu_principal()
Application.ScreenUpdating = False
Feuil1.Activate
Get_cours
Convertir
Maj_Valo
Delnomcell
Application.Goto reference:=Feuil4.Cells(2, 4), Scroll:=False
Addit
MsgBox ("Mise  à jour effectuée")
End Sub

'   RECUPERATION DE COTATION SUR MSN FLA 06-12-05
'Const BaseUrl = "URL;http://fr.moneycentral.msn.com/investor/quotes/quotes.asp?Symbol="
Sub Get_cours()
Dim URL1 As String, RngList As Range, BaseUrl As String
Dim Tempo As Worksheet, Webdata As Worksheet, C
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Razo
BaseUrl = "URL;http://fr.moneycentral.msn.com/investor/quotes/quotes.asp?Symbol="
'http://fr.moneycentral.msn.com/investor/quotes/quotes.asp?Symbol=OR
Set Webdata = Feuil1
Set Tempo = Feuil3
Set RngList = Webdata.Range("A2", [A2].End(xlDown))
Webdata.Activate
Transfert_datas
Y = Cells(65536, 1).End(xlUp).Row + 1
Range("A2:A" & Y).Name = "Isin"
'Transfert_datas
For Each C In RngList
    URL1 = BaseUrl & C.Value
    With Tempo.QueryTables.Add(Connection:=URL1, Destination:=Tempo.Range("A2"))
    .BackgroundQuery = True
    .WebFormatting = xlWebFormattingNone
    '.WebTables = "28"
    .TablesOnlyFromHTML = False
    .Refresh BackgroundQuery:=False
    .SaveData = True
    End With
    C.Offset(0, 2).Value = Tempo.Range("j18").Value
    Tempo.UsedRange.Delete
Next C
Application.DisplayAlerts = False
Cells(1, 5) = Date
Application.Calculation = xlCalculationAutomatic
End Sub

Sub Transfert_datas()    ' ALIMENTATION DE LA BASE POUR MISE A JOUR DES CODES
                                             ' AVANT RECUPERATION DES DERNIERS COURS
Y = Feuil4.Range("A65536").End(xlUp).Row
Range("A2:A" & Y) = Feuil4.Range("B3:B" & Y).Value
Range("A" & Y).ClearContents
End Sub

Sub Convertir() 'CONVERSION EN NUMÉRIQUE D'UN NOMBRE EXPRIMÉ EN TEXTE '
Application.ScreenUpdating = False
Dim X As Variant, C
Y = Feuil1.Range("A65536").End(xlUp).Row
Set Plage = Range("C2:C" & Y)
With Plage
    X = ","
    Set C = Plage.Find(X, LookIn:=xlValues)
    If C Is Nothing Then
      GoTo fin
      Else
    Plage.Replace What:=",", _
        Replacement:=".", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False
    For Each X In Plage
    X.Formula = CDbl(X)
    Next
    End If
End With
fin:
End Sub

Sub Maj_Valo()  ' CALCUL DES VALOS  DU PORTEFEUILLE
Dim Ldepart&
Application.ScreenUpdating = False
Feuil4.Activate
Range("B3").Name = "First"
Cells(1, 5) = Date
Ldepart = Range("first").Row
Y = Range("A65536").End(xlUp).Row
Range("First").Offset(0, 5).Select
Set Plage = Range(ActiveCell, ActiveCell).Resize(1 + Y - Ldepart, 3)
Plage.FillDown
Range("A2:I" & Y).Name = "Portofolio"

End Sub

' RAZ  DE LA ZONE DE STOCKAGE
Sub Razo()
'RAZ DE LA FEUILLE BASE
With Feuil1
Application.DisplayAlerts = False
Cells(1, 1).Name = "Code"
Y = Range("A65536").End(xlUp).Row
Range("C2:F" & Y).ClearContents
End With
Feuil3.Range("a1:iv65000").Clear
Application.DisplayAlerts = True
End Sub

Sub Delnomcell()
' SUPPRESSION DES NOMS TEMPORAIRES DE LA FEUILLE
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Nom As Object
Feuil3.Activate
For Each Nom In ActiveSheet.Names
    'Select Case MsgBox("Voulez-vous supprimer le nom défini " & Nom.Name & " Faisant référence à : " & Nom.RefersTo, vbYesNo, "Suppression du nom ?")
     '   Case vbYes
            Nom.Delete
    'End Select
Next Nom
Application.Calculation = xlCalculationAutomatic
End Sub

Public Sub Addit()
' Totalisation des lignes de la feuille Valo
Application.ScreenUpdating = False
'Feuil4.Activate
Cells(1, 6).Select
Dim Rng As Range, Z&
  Z = ActiveCell.End(xlDown).Row
  With ActiveCell
    Set Rng = Range(.Offset(1), .End(xlDown))
    .Interior.ColorIndex = 4
    .Formula = "=SUM(" & _
        Rng.Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
  End With
ActiveCell.Copy Cells(1, 8)
ActiveCell.Copy Cells(1, 9)
End Sub