Golden Age

Function AnalyseMap(Feuille As String)
    Dim R As Range
    Dim MyRange As Range
    Dim Resultat As String
    Dim idCarte As String
    On Error GoTo Except
    idCarte = InputBox("Identifiant de la carte ?", "Demande de renseignements")
    Open "C:\Documents and Settings\Moustik\Bureau\Golden Age V3\cartes\Map" & idCarte & ".txt" For Append As #1
    Sheets(Feuille).Select
    Set MyRange = Range("A1:AX50") 'La map complète
    For Each R In MyRange
        If R.Value = "" Then R.Value = 0
        Print #1, "$sql = ""INSERT INTO Cases(id_carte, id_type_case, id_porte, x_case,y_case) VALUES('" & _
        idCarte & "','" & R.Value & "','0','" & R.Row & "','" & R.Column & "')"";" & vbCr & _
        "mysql_query($sql) or die('Erreur SQL !'.$sql.'<br>'.mysql_error());"
    Next R
    Close #1
Exit Function
Except:
    Call MsgBox("Erreur: " & Err.Number & vbCrLf & _
    Err.Description, vbMsgBoxHelpButton, , Err.HelpFile, Err.HelpContext)
    Close #1
End Function

Function RenverseMap(Feuille As String)
    ' Déclarations
    Dim R As Range
    Dim MyRange As Range
    Dim NewFeuille As String
    Dim Valeur As String
    Dim Ligne As Long
    Dim Colonne As Long
    ' Traitement
    Application.ScreenUpdating = False 'Pour optimiser le temps de calcul
    On Error GoTo Except
    NewFeuille = InputBox("Nom de la nouvelle carte ?", "Demande de renseignements")
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    Sheets(Worksheets.Count).Name = NewFeuille
    Sheets("Map").Select
    Set MyRange = Range("A1:AX50") 'Zone de map
    For Each R In MyRange
        Valeur = R.Value 'On enregistre la valeur
        Ligne = 51 - R.Row 'La nouvelle ligne (51 - Row donne la nouvelle ligne)
        Colonne = 51 - R.Column 'La nouvelle colonne (51 - Column donne la nouvelle colonne)
        ' la cellule prend la valeur enregistrée
        With Sheets(Worksheets.Count).Cells(Ligne, Colonne)
            .Value = Valeur
            .Font.Size = 6
        End With
        Sheets(1).Select
    Next R
    ' On modifie la largeur et la hauteur des cellules de la nouvelle feuille
    Sheets(Worksheets.Count).Select
    Range("A1:AX50").ColumnWidth = 1
    Range("A1:AX50").RowHeight = 8
    Application.ScreenUpdating = True 'Fin d'optimisation
Exit Function
' En cas d'erreur :
Except:
    Call MsgBox("Erreur: " & Err.Number & vbCrLf & _
    Err.Description, vbMsgBoxHelpButton, , Err.HelpFile, Err.HelpContext)
End Function

        Ligne = R.Column
        Colonne = 51 - R.Row