RaiderTab SourceCode 6.0.20.2

Sub TriRenta()

'Cette Macro est la macro principale générant le tableau. Elle appelle toutes les autres
'This Macro is the main Macro that generates the board. You have to launch this Macro to generate the board

Dim Plage As Range, LigneCoords As Range
Dim LigneCoordTrouvee As String, PremiereLigneTrouvee As String
Dim NbCells As Integer, CurCell As Object, ActiveLine As Integer
'Variables de calcul GT et PT :
Dim NbPT As Long, NbGT As Long
'Variable Bouton
Dim Btn As Button, t As Range
'Comptage du nombre de vagues
Dim NbVagues As Integer
'Récupération de la quantité de gains nécessaires pour créer une seconde vague
Dim RentaUser As Long
'Variable permettant d'envoyer plus de PT que nécessaire
'Allow More Cargos than necessary
Dim PTMore As String
'Déclaration des variables de langue
'Language Variables
Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range


Application.ScreenUpdating = False
'Zone de détection de langue
Langue = Range("Z14").Value
'recherche de la langue
Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)

'vérification de si la langue existe
'Check if language exists
If TrouveLangue Is Nothing Then
    MsgBox ("Please Set good language in Z4 cell. If your language is not in the table, you can create it by adding it on the list.")
    End
Else
    Range(TrouveLangue.Address).Select
End If

'Affectation des valeurs aux variables
'Affecting value to variables
MillionsLangue = ActiveCell.Offset(1, 0).Value
MillionsLangueLenght = Len(MillionsLangue)
MilliardsLangue = ActiveCell.Offset(2, 0).Value
MilliardsLangueLenght = Len(MilliardsLangue)
PonctMLangue = ActiveCell.Offset(3, 0).Value
PonctMdLangue = ActiveCell.Offset(4, 0).Value
RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
FlottesLangue = ActiveCell.Offset(6, 0).Value
DefLangue = ActiveCell.Offset(7, 0).Value
JoueurLangue = ActiveCell.Offset(8, 0).Value
ActiviteLangue = ActiveCell.Offset(9, 0).Value
RessourcesLangue = ActiveCell.Offset(10, 0).Value

'Msgbox De vérification des variables :
'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)






NbVagues = 1
PTMore = Range("Z12").Value
RentaUser = Range("Z5").Value * 2
Set Plage = ActiveSheet.Range("B2:B5000")

'----------------------------------------------------------
'décolorisation de la plage
'
'cleaning colors of the selected range
Range("A2:Q5000").Select
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
With Selection.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
End With


'Nettoyage de la zone de tri
'cleaning contents in selected range
Range("B2:Q5000").Select
Selection.ClearContents

'MsgBox ("a")
'-----------------------------------------------------------

'Appel des Sub
'calling others macros
Call ChercheJoueurs
Call ChercheCoords
Call ChercheLoot
Call ChercheRessourcesNew
Call ChercheDefsFeets

'-----------------------------------------------------------

'Recherche des lignes contenant des coordonnées
'Searching lines containing coords

Application.StatusBar = "Création des données du tableau..."
Set LigneCoords = Plage.Cells.Find(what:=":", LookAt:=xlPart)
If LigneCoords Is Nothing Then
    'Dans le cas où aucune coord n'est trouvée
    'If no coords are found
    LigneCoordTrouvee = "Aucune Coordonnée n'est présente dans la plage " & Plage.Address
Else
    'Dans le cas où une coordonnée est trouvée, traitement des infos lui étant associées
    'If a coord is found, it launches calculation of associated datas
    PremiereLigneTrouvee = LigneCoords.Address
    Do
        LigneCoordTrouvee = LigneCoords.Address
        Range(LigneCoords.Address).Select
        'Calcul de la renta finale
        ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(0, 2) * ActiveCell.Offset(0, 6)
        'Si le ratio est égal à 0.5 et que la renta dépasse 3 millions, créer une ligne supplémentaire correspondant à une autre vague :
        'this parts create others waves, when the amount of profit is more than what wished user
        If ActiveCell.Offset(0, 7).Value >= RentaUser Then
            If ActiveCell.Offset(0, 6).Value <= 0.75 Then
                If NbVagues < 6 Then
                    ActiveCell.Offset(1, 0).Value = ActiveCell.Value
                    ActiveCell.Offset(1, 1).Value = ActiveCell.Offset(0, 1).Value
                    ActiveCell.Offset(1, 2).Value = ActiveCell.Offset(0, 2).Value * (1 - ActiveCell.Offset(0, 6).Value)
                    ActiveCell.Offset(1, 3).Value = ActiveCell.Offset(0, 3).Value * (1 - ActiveCell.Offset(0, 6).Value)
                    ActiveCell.Offset(1, 4).Value = ActiveCell.Offset(0, 4).Value * (1 - ActiveCell.Offset(0, 6).Value)
                    ActiveCell.Offset(1, 5).Value = ActiveCell.Offset(0, 5).Value * (1 - ActiveCell.Offset(0, 6).Value)
                    ActiveCell.Offset(1, 6).Value = ActiveCell.Offset(0, 6).Value
                    ActiveCell.Offset(1, 8).Value = ActiveCell.Offset(0, 8).Value * (1 - ActiveCell.Offset(0, 6).Value)
                    ActiveCell.Offset(1, 10).Value = ActiveCell.Offset(0, 10).Value
                    ActiveCell.Offset(1, 11).Value = ActiveCell.Offset(0, 11).Value

                    'Colorisation de la seconde vague en jaune
                    'Next wave = yellow in coords
                    With ActiveCell.Offset(1, 0).Interior
                        .Pattern = xlUp
                        .PatternColor = 65535
                        .Color = 49407
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    'MsgBox ("Vague crée")
                    NbVagues = NbVagues + 1
                End If
            End If
        Else
            NbVagues = 1
        End If
        'MsgBox NbVagues
        'Calcul du nombre de PT et GT
        ActiveCell.Offset(0, 7).Select
        NbPT = ActiveCell.Value / 5000 * PTMore
        ActiveCell.Offset(0, 5).Value = NbPT
        NbGT = ActiveCell.Value / 25000 * PTMore
        ActiveCell.Offset(0, 6).Value = NbGT
        'Comptage du Nombre de RE donnés à l'excel
        Set LigneCoords = Plage.Cells.FindNext(LigneCoords)
    Loop While Not LigneCoords Is Nothing And LigneCoords.Address <> PremiereLigneTrouvee
    ' Tri des lignes afin de les ramener tout en haut
    Range("B2:Q5000").Sort Key1:=Range("I1"), Order1:=xlDescending
    'Appel de la fonction de renta heure
    Call RentaHeure
    'Second tri
    Range("B2:Q5000").Sort Key1:=Range(Range("Z13").Value & "1"), Order1:=xlDescending
    'Comptage du nombre de lignes contenant une coordonnée
    NbCells = Application.WorksheetFunction.CountA(Range("B2:B5000"))
    '
    '---------------------------------------------------------------------------------------
    'Colorisation des flottes et défenses
    Application.StatusBar = "Colorisation..."
    For Each CurCell In Range("L2:M" & NbCells + 1)
        If CurCell.Value > 0 Then
            Range(CurCell.Address).Select
            With Selection.Interior
                .Pattern = xlUp
                .PatternColor = 999
                .Color = 126
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
        If CurCell.Value = 0 Then
            Range(CurCell.Address).Select
            With Selection.Interior
                .Pattern = xlUp
                .PatternThemeColor = xlThemeColorAccent3
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.599963377788629
                .PatternTintAndShade = 0.399945066682943
            End With
        End If
        If CurCell.Value = "" Then
            Range(CurCell.Address).Select
            With Selection.Interior
                .Pattern = xlUp
                .PatternColor = 65535
                .Color = 49407
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    Next
    '-----------------------------------------------------------------------
    'Colorisation des renta
    For Each CurCell In Range("I2:I" & NbCells + 1)
        If CurCell.Value > 1500000 Then
            Range(CurCell.Address).Select
            Range("I" & ActiveCell.Row & ":K" & ActiveCell.Row).Select
            With Selection.Interior
                .Pattern = xlUp
                .PatternThemeColor = xlThemeColorAccent3
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.599963377788629
                .PatternTintAndShade = 0.399945066682943
            End With
            Range("D" & ActiveCell.Row & ":G" & ActiveCell.Row).Select
            With Selection.Interior
                .Pattern = xlUp
                .PatternThemeColor = xlThemeColorAccent3
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.599963377788629
                .PatternTintAndShade = 0.399945066682943
            End With
        End If
        If CurCell.Value < 750000 Then
            Range(CurCell.Address).Select
            Range("I" & ActiveCell.Row & ":K" & ActiveCell.Row).Select
            With Selection.Interior
                .Pattern = xlUp
                .PatternThemeColor = xlThemeColorAccent6
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = -0.249946592608417
                .PatternTintAndShade = -0.499984740745262
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
            Range("D" & ActiveCell.Row & ":G" & ActiveCell.Row).Select
            With Selection.Interior
                .Pattern = xlUp
                .PatternThemeColor = xlThemeColorAccent6
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = -0.249946592608417
                .PatternTintAndShade = -0.499984740745262
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
    Next
    'Création de l'URL
    '-----------------------------------
    Call ExtractCoordCreationURL


End If

Call Statistiques
Range("P2").Select
If Range("W5").Value > 1000000 Then
    If Range("W5").Value < 2000000 Then
        Application.StatusBar = "Génération du tableau terminée ! :)"
    Else
        Application.StatusBar = "Génération du tableau terminée ! Jolis pillages en perspective, Enjoy :)"
    End If
End If
If Range("W5").Value < 1000000 Then
        Application.StatusBar = "Génération du tableau terminée ! Pas terrible cette vague :/"
End If




End Sub


Sub ChercheJoueurs()
'Déclaration des variables de recherche :
Dim Trouve As Range, PlageDeRecherche As Range, TrouveSplit() As String
Dim Valeur_Cherchee As String, AdresseTrouvee As String, PremiereAdresseTrouvee As String
'Déclaration des variables d'extraction de ressources :
Dim TempPlayer As String, EmplacementPlayer As String, EmplacementPlayerSplit As String, Parentheses As String, SplitPlayer As String, Activite As String, EmplacementPlayerSplitTwo() As String
'Déclaration des variables de la barre de progression
Dim Pourcentage As Long, NbLignes As Long, Ligne As Long
'Déclaration de la variable permettant de compter le nombre de RE
Dim NombreRE As Integer
'Déclaration des variables de langue
Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range

'Zone de détection de langue
Langue = Range("Z14").Value
'recherche de la langue
Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)

'vérification de si la langue existe
If TrouveLangue Is Nothing Then
    MsgBox ("Please Set good language in Z4 cell. If your language is not in the table, you can create it by adding it on the list.")
    End
Else
    Range(TrouveLangue.Address).Select
End If

'Affectation des valeurs aux variables
MillionsLangue = ActiveCell.Offset(1, 0).Value
MillionsLangueLenght = Len(MillionsLangue)
MilliardsLangue = ActiveCell.Offset(2, 0).Value
MilliardsLangueLenght = Len(MilliardsLangue)
PonctMLangue = ActiveCell.Offset(3, 0).Value
PonctMdLangue = ActiveCell.Offset(4, 0).Value
RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
FlottesLangue = ActiveCell.Offset(6, 0).Value
DefLangue = ActiveCell.Offset(7, 0).Value
JoueurLangue = ActiveCell.Offset(8, 0).Value
ActiviteLangue = ActiveCell.Offset(9, 0).Value
RessourcesLangue = ActiveCell.Offset(10, 0).Value

'Msgbox De vérification des variables :
'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)



'Affecation des valeurs aux variables :
'Application.ScreenUpdating = False
Valeur_Cherchee = JoueurLangue

Pourcentage = 0
NombreRE = 0
Range("W37").Value = 0

'Comptage du nombre de lignes
NbLignes = Cells(Rows.Count, 1).End(xlUp).Row
'Dans la plage :
Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")

'Recherche de la ligne "Joueur"
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)

'MsgBox Trouve

If Trouve Is Nothing Then
    'Dans le cas où la donnée n'est pas trouvée
    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
    'Dans le cas où "Joueur"/"Player" est trouvé, exctraction de la coordonnée se trouvant derrière
    PremiereAdresseTrouvee = Trouve.Address
    Do
        AdresseTrouvee = Trouve.Address
        NombreRE = NombreRE + 1
        Range(Trouve.Address).Select
        TrouveSplit = Split(Trouve, ":")
        EmplacementPlayer = TrouveSplit(1)
        'MsgBox ("|" & EmplacementPlayer & "|")


        EmplacementPlayer = Replace(EmplacementPlayer, ActiviteLangue, "")
        'MsgBox ("|" & EmplacementPlayer & "|")
        EmplacementPlayerSplitTwo = Split(EmplacementPlayer, "(")
        SplitPlayer = EmplacementPlayerSplitTwo(0)
        SplitPlayer = Mid(SplitPlayer, 3)
        'MsgBox ("|" & SplitPlayer & "|")

        ActiveCell.Offset(0, 2).Value = SplitPlayer

        'Recherche de la prochaine ligne
        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
        Ligne = ActiveCell.Row
        Range("W37").Value = Ligne / NbLignes * 100
        Application.StatusBar = "Traitement des pseudos  " + CStr([W37]) + "%"
    Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
End If

'MsgBox AdresseTrouvee
'Vidage des variables
Range("W14").Value = NombreRE
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub

Sub ChercheCoords()
'Déclaration des variables de recherche :
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String, PremiereAdresseTrouvee As String
'Déclaration des variables d'extraction de ressources :
Dim TempCoord As String, EmplacementCoord As String, EmplacementFinCoord As String
Dim Pourcentage As Long, NbLignes As Long, Ligne As Long

'Déclaration des variables de langue
Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range

'Zone de détection de langue
Langue = Range("Z14").Value
'recherche de la langue
Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)

'vérification de si langue langue existe
'checking if language exists
If TrouveLangue Is Nothing Then
    MsgBox ("Please Set good language in Z4 cell. If your language is not in the table, you can create it by adding it on the list.")
    End
Else
    Range(TrouveLangue.Address).Select
End If

'Affectation des valeurs aux variables
MillionsLangue = ActiveCell.Offset(1, 0).Value
MillionsLangueLenght = Len(MillionsLangue)
MilliardsLangue = ActiveCell.Offset(2, 0).Value
MilliardsLangueLenght = Len(MilliardsLangue)
PonctMLangue = ActiveCell.Offset(3, 0).Value
PonctMdLangue = ActiveCell.Offset(4, 0).Value
RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
FlottesLangue = ActiveCell.Offset(6, 0).Value
DefLangue = ActiveCell.Offset(7, 0).Value
JoueurLangue = ActiveCell.Offset(8, 0).Value
ActiviteLangue = ActiveCell.Offset(9, 0).Value
RessourcesLangue = ActiveCell.Offset(10, 0).Value

'Msgbox De vérification des variables :
'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)


'Affecation des valeurs aux variables :
Valeur_Cherchee = RapportDespionnageLangue
'MsgBox Valeur_Cherchee

Range("W37").Value = 0
Pourcentage = 0
'MsgBox Valeur_Cherchee
'Dans la plage :
Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")
NbLignes = Cells(Rows.Count, 1).End(xlUp).Row

'Recherche de la ligne "Joueur"
'seach lines containing "Player"
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
'MsgBox Trouve

If Trouve Is Nothing Then
    'Dans le cas où la donnée n'est pas trouvée
    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
    'Dans le cas où "Joueur" est trouvé, exctraction de la coordonnée se trouvant derrière
    PremiereAdresseTrouvee = Trouve.Address
    Do
        AdresseTrouvee = Trouve.Address
        Range(Trouve.Address).Select
        ActiveCell.Offset(0, 1).Select
        'Recherche de la "coordonnée" des caractères [ et ], afin de définir ensuite où couper la chaînes de caractère
        EmplacementCoord = InStr(Trouve, "[")
        EmplacementFinCoord = InStr(Trouve, "]")
        'MsgBox (EmplacementCoord)
        'MsgBox (EmplacementFinCoord)

        'Utilisation de EmplacementCoord et EmplacementFinCoord pour récupérer la zone où se trouve la coordonnée
        'This line extracts the coord from the string
        TempCoord = Mid(Trouve, EmplacementCoord + 1, EmplacementFinCoord - EmplacementCoord - 1)
        'MsgBox (TempCoord)
        ActiveCell.Offset(4, 0).Value = TempCoord
            With ActiveCell.Offset(4, 0).Interior
                .Pattern = xlUp
                .PatternThemeColor = xlThemeColorAccent3
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.599963377788629
                .PatternTintAndShade = 0.399945066682943
            End With
        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)

        'Calcul du pourcentage
        Ligne = ActiveCell.Row
        Range("W37").Value = Ligne / NbLignes * 100
        Application.StatusBar = "Traitement des coordonnées  " + CStr([W37]) + "%"


    Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
End If

'MsgBox AdresseTrouvee
'Vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub



Sub ChercheRessourcesNew()

'Déclaration des variables de recherche
Dim Trouve As Range, PlageDeRecherche As Range, Valeur_Cherchee As String, AdresseTrouvee As String, PremiereAdresseTrouvee As String
'Déclaration des variables d'extraction de coordonnées :
Dim Ressources As String, LigneRessources As String, LigneRessourcesSplit() As String, Metal As String, Cristal As String, Deuterium As String
'Déclaration des variables de calcul de progression de traitement :
Dim Pourcentage As Long, NbLignes As Long, Ligne As Long
'Déclaration des variables pour l'USM :
Dim USMString As String, USMStringSplit() As String, USMMetal As String, USMCristal As String, USMDeut As String, RessourcesUSM As String, Ratio As String
'Déclaration des variables de langue
Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range, CristalLangue As String, DeuteriumLangue As String

'Zone de détection de langue
Langue = Range("Z14").Value
'recherche de la langue
Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)

'vérification de si la langue existe
If TrouveLangue Is Nothing Then
    MsgBox ("Please Set good language in Z4 cell. If your language is not in the table, you can create it by adding it on the list.")
    End
Else
    Range(TrouveLangue.Address).Select
End If

'Affectation des valeurs aux variables
MillionsLangue = ActiveCell.Offset(1, 0).Value
MillionsLangueLenght = Len(MillionsLangue)
MilliardsLangue = ActiveCell.Offset(2, 0).Value
MilliardsLangueLenght = Len(MilliardsLangue)
PonctMLangue = ActiveCell.Offset(3, 0).Value
PonctMdLangue = ActiveCell.Offset(4, 0).Value
RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
FlottesLangue = ActiveCell.Offset(6, 0).Value
DefLangue = ActiveCell.Offset(7, 0).Value
JoueurLangue = ActiveCell.Offset(8, 0).Value
ActiviteLangue = ActiveCell.Offset(9, 0).Value
RessourcesLangue = ActiveCell.Offset(10, 0).Value
CristalLangue = ActiveCell.Offset(12, 0).Value
DeuteriumLangue = ActiveCell.Offset(13, 0).Value

'Msgbox De vérification des variables :
'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)


'Affectation des valeurs aux variables :
Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")
Valeur_Cherchee = RessourcesLangue
Pourcentage = 0
NbLignes = 0
Ligne = 0
NbLignes = Cells(Rows.Count, 1).End(xlUp).Row
'Mise à 0 du pourcentage :
Application.StatusBar = "Traitement des coordonnées : 0%"

'Récupération du taux USM

USMString = Range("W21").Value
USMStringSplit = Split(USMString, "/")
USMMetal = USMStringSplit(0)
USMCristal = USMStringSplit(1)
USMDeut = USMStringSplit(2)
'MsgBox ("Le taux USM est de : " & USMMetal & "/" & USMCristal & "/" & USMDeut)


'Recherche
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)

If Trouve Is Nothing Then

    'Dans le cas où la donnée n'est pas trouvée
    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
    'Dans le cas où "Resources: " est trouvé, extraction de la coordonnée se trouvant derrière
    PremiereAdresseTrouvee = Trouve.Address
    Do
        AdresseTrouvee = Trouve.Address
        Range(Trouve.Address).Select
        'LigneRessources va récupérer le contenu de la variable

        LigneRessources = ActiveCell.Value
        LigneRessourcesSplit = Split(LigneRessources, ":")
        'Séparation des 3 ressources + ressources dans 4 variables distinctes
        Metal = LigneRessourcesSplit(1)
        Cristal = LigneRessourcesSplit(2)
        Deuterium = LigneRessourcesSplit(3)
        Ressources = LigneRessourcesSplit(4)
        'Nettoyage des mots restants dans les variables
        Metal = Replace(Metal, CristalLangue, "")
        Metal = Replace(Metal, " ", "")
        If Right(Metal, MilliardsLangueLenght) = MilliardsLangue Then
            Metal = Replace(Metal, MilliardsLangue, "")
            Metal = Replace(Metal, PonctMdLangue, ",")
            Metal = Metal * 1000000000
            'MsgBox ("La valeur de métal est de : " & Metal)
        End If
        If Right(Metal, MillionsLangueLenght) = MillionsLangue Then
            Metal = Replace(Metal, MillionsLangue, "")
            Metal = Replace(Metal, PonctMdLangue, ",")
            Metal = Metal * 1000000
            'MsgBox ("La valeur de métal est de : " & Metal)
        End If

        'Cristal
        Cristal = Replace(Cristal, DeuteriumLangue, "")
        Cristal = Replace(Cristal, " ", "")
        If Right(Cristal, MilliardsLangueLenght) = MilliardsLangue Then
            Cristal = Replace(Cristal, MilliardsLangue, "")
            Cristal = Replace(Cristal, PonctMdLangue, ",")
            Cristal = Cristal * 1000000000
            'MsgBox ("La valeur de métal est de : " & Cristal)
        End If
        If Right(Cristal, MillionsLangueLenght) = MillionsLangue Then
            Cristal = Replace(Cristal, MillionsLangue, "")
            Cristal = Replace(Cristal, PonctMdLangue, ",")
            Cristal = Cristal * 1000000
            'MsgBox ("La valeur de métal est de : " & Cristal)
        End If

        'Deutérium
        Deuterium = Replace(Deuterium, Left(RessourcesLangue, Len(RessourcesLangue) - 1), "")
        Deuterium = Replace(Deuterium, " ", "")
        If Right(Deuterium, MilliardsLangueLenght) = MilliardsLangue Then
            Deuterium = Replace(Deuterium, MilliardsLangue, "")
            Deuterium = Replace(Deuterium, PonctMdLangue, ",")
            Deuterium = Deuterium * 1000000000
            'MsgBox ("La valeur de métal est de : " & Deuterium)
        End If
        If Right(Deuterium, MillionsLangueLenght) = MillionsLangue Then
            Deuterium = Replace(Deuterium, MillionsLangue, "")
            Deuterium = Replace(Deuterium, PonctMdLangue, ",")
            Deuterium = Deuterium * 1000000
            'MsgBox ("La valeur de métal est de : " & Deuterium)
        End If

        'Ressources
        Ressources = Replace(Ressources, Left(RessourcesLangue, Len(RessourcesLangue) - 1), "")
        Ressources = Replace(Ressources, " ", "")
        If Right(Ressources, MilliardsLangueLenght) = MilliardsLangue Then
            Ressources = Replace(Ressources, MilliardsLangue, "")
            Ressources = Replace(Ressources, PonctMdLangue, ",")
            Ressources = Ressources * 1000000000
            'MsgBox ("La valeur de métal est de : " & Ressources)
        End If
        If Right(Ressources, MillionsLangueLenght) = MillionsLangue Then
            Ressources = Replace(Ressources, MillionsLangue, "")
            Ressources = Replace(Ressources, PonctMdLangue, ",")
            Ressources = Ressources * 1000000
            'MsgBox ("La valeur de métal est de : " & Ressources)
        End If
        Metal = Replace(Metal, PonctMLangue, "")
        Cristal = Replace(Cristal, PonctMLangue, "")
        Deuterium = Replace(Deuterium, PonctMLangue, "")
        Ressources = Replace(Ressources, PonctMLangue, "")


        'MsgBox ("Métal:        " & Metal & vbNewLine & "Cristal:        " & Cristal & vbNewLine & "Deut :        " & Deuterium & vbNewLine & "Ressources :        " & Ressources)


        'MsgBox LigneRessources
        'Calcul de la valeur USM :
        RessourcesUSM = (Metal * USMDeut) + (Cristal * USMCristal) + (Deuterium * USMMetal)
        'Note : Le ratio doit avoir été récupéré avec la fonction ChercheLoot
        Ratio = ActiveCell.Offset(-1, 7).Value
        RessourcesUSM = RessourcesUSM * Ratio
        RessourcesUSM = RessourcesUSM
        'MsgBox ("La valeur USM des ressources est de " & RessourcesUSM & "la valeur de la renta est de " & Ressources / 2)


        'Ecriture des données dans le tableau
        'writing datas on board
        ActiveCell.Offset(-1, 3) = Int(Ressources)
        ActiveCell.Offset(-1, 4) = Int(Metal)
        ActiveCell.Offset(-1, 5) = Int(Cristal)
        ActiveCell.Offset(-1, 6) = Int(Deuterium)
        ActiveCell.Offset(-1, 9) = Int(RessourcesUSM)


        'Recherche de la prochaine correspondance "Resources:" :
        'search next line with "resources" inside
        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
        Metal = 0
        Cristal = 0
        Deuterium = 0
        Ressources = 0
        'Variable de traitement du pourcentage (explications : toutes les 2 valeurs trouvées, le pourcentage est recaculé. ça permet d'éviter une surchage inutile au programme)
        Pourcentage = Pourcentage + 1

        Ligne = ActiveCell.Row
        Range("W37").Value = Ligne / NbLignes * 100
        Application.StatusBar = "Traitement des ressources  " + CStr([W37]) + "%"



    Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
End If

End Sub



Sub ChercheLoot()
'Déclaration des variables de recherche :
Dim Trouve As Range, PlageDeRecherche As Range, TrouveSplit() As String, Part As String, PartSplit() As String, Loot As String, Ratio As Single
Dim Valeur_Cherchee As String, AdresseTrouvee As String
'Déclaration des variables de mise en forme :
Dim Pourcentage As Long, NbLignes As Long, Ligne As Long
'Déclaration des variables de langue
Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range, ButinLangue As String

'Zone de détection de langue
Langue = Range("Z14").Value
'recherche de la langue
Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)

'vérification de si la langue existe
If TrouveLangue Is Nothing Then
    MsgBox ("Please Set good language in Z4 cell. If your language is not in the table, you can create it by adding it on the list.")
    End
Else
    Range(TrouveLangue.Address).Select
End If

'Affectation des valeurs aux variables
MillionsLangue = ActiveCell.Offset(1, 0).Value
MillionsLangueLenght = Len(MillionsLangue)
MilliardsLangue = ActiveCell.Offset(2, 0).Value
MilliardsLangueLenght = Len(MilliardsLangue)
PonctMLangue = ActiveCell.Offset(3, 0).Value
PonctMdLangue = ActiveCell.Offset(4, 0).Value
RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
FlottesLangue = ActiveCell.Offset(6, 0).Value
DefLangue = ActiveCell.Offset(7, 0).Value
JoueurLangue = ActiveCell.Offset(8, 0).Value
ActiviteLangue = ActiveCell.Offset(9, 0).Value
RessourcesLangue = ActiveCell.Offset(10, 0).Value
ButinLangue = ActiveCell.Offset(11, 0).Value

'Msgbox De vérification des variables :
'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)


'Affectation des valeurs aux variables
Valeur_Cherchee = ButinLangue
Range("W37").Value = 0
Pourcentage = 0
'Dans la plage :
Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")
NbLignes = Cells(Rows.Count, 1).End(xlUp).Row

'Utilisation de la méthode Find
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
'MsgBox Trouve
If Trouve Is Nothing Then
    'Dans le cas où la donnée n'est pas trouvée
    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
    'Dans le cas où "Player" est trouvé, exctraction de la coordonnée se trouvant derrière
    PremiereAdresseTrouvee = Trouve.Address
    Do
        AdresseTrouvee = Trouve.Address
        Range(Trouve.Address).Select
        ActiveCell.Offset(-2, 7).Select
        'Découpage de la chaine de caractère en cherchant d'abord ":" puis "%" afin de localiser le chiffre
        TrouveSplit = Split(Trouve, ":")
        Part = TrouveSplit(1)
        'MsgBox (Part)
        PartSplit = Split(Part, "%")
        Loot = PartSplit(0)
        Loot = Replace(Loot, " ", "")

        'Passage du % de butin en ratio
        Ratio = Loot / 100
        ActiveCell.Value = Ratio
        'MsgBox (Ratio)

        'Recherche de la ligne suivante
        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
        'Calcul du pourcentage d'avancement

        Ligne = ActiveCell.Row
        Range("W37").Value = Ligne / NbLignes * 100
        Application.StatusBar = "Traitement des ratios  " + CStr([W37]) + "%"
    Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
End If

'MsgBox AdresseTrouvee
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub

Sub ChercheDefsFeets()

'Déclaration des variables de recherche :
Dim Trouve As Range, PlageDeRecherche As Range, TrouveSplit() As String, Flotte As String, Def As String, FlotteSplit() As String, FlotteFinal As String, FlotteSingle As Single, DefSingle As Single
Dim Valeur_Cherchee As String, AdresseTrouvee As String
'Variables de gestion de ligne
Dim Ligne As Integer
'Déclaration des variables de langue
Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range

'Zone de détection de langue
Langue = Range("Z14").Value
'recherche de la langue
Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)

'vérification de si la langue existe
If TrouveLangue Is Nothing Then
    MsgBox ("Please Set good language in Z4 cell. If your language is not in the table, you can create it by adding it on the list.")
    End
Else
    Range(TrouveLangue.Address).Select
End If

'Affectation des valeurs aux variables
MillionsLangue = ActiveCell.Offset(1, 0).Value
MillionsLangueLenght = Len(MillionsLangue)
MilliardsLangue = ActiveCell.Offset(2, 0).Value
MilliardsLangueLenght = Len(MilliardsLangue)
PonctMLangue = ActiveCell.Offset(3, 0).Value
PonctMdLangue = ActiveCell.Offset(4, 0).Value
RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
FlottesLangue = ActiveCell.Offset(6, 0).Value
DefLangue = ActiveCell.Offset(7, 0).Value
JoueurLangue = ActiveCell.Offset(8, 0).Value
ActiviteLangue = ActiveCell.Offset(9, 0).Value
RessourcesLangue = ActiveCell.Offset(10, 0).Value

'Msgbox De vérification des variables :
'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)


'Affectation des valeurs aux variables
Valeur_Cherchee = FlottesLangue
Range("W37").Value = 0
Pourcentage = 0
I = 0
'Dans la plage :
Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")
NbLignes = Cells(Rows.Count, 1).End(xlUp).Row

'Utilisation de la méthode Find
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
'MsgBox Trouve


If Trouve Is Nothing Then
    'Dans le cas où la donnée n'est pas trouvée
    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
    'Dans le cas où "Player" est trouvé, exctraction de la coordonnée se trouvant derrière
    PremiereAdresseTrouvee = Trouve.Address
    Do
        'MsgBox (Trouve)
        AdresseTrouvee = Trouve.Address
        Range(Trouve.Address).Select

        Flotte = ""
        Def = ""
        TrouveSplit = Split(Trouve, ":")
        Flotte = TrouveSplit(1)
        'Vérification de si la ligne contient bien des défenses afin d'éviter des erreurs
        If Trouve Like "*" & DefLangue & "*" Then
            Def = TrouveSplit(2)
        End If
        'MsgBox ("Flotte :" & Flotte & " | Défense :" & Def)

        FlotteSplit = Split(Flotte, DefLangue)
        FlotteFinal = FlotteSplit(0)

        FlotteFinal = Replace(FlotteFinal, " ", "")
        Def = Replace(Def, " ", "")
        'MsgBox ("Flotte :" & FlotteFinal & " | Défense :" & Def)


        'Mise en forme des millions et milliards
        If Right(FlotteFinal, MilliardsLangueLenght) = MilliardsLangue Then
            FlotteFinal = Replace(FlotteFinal, MilliardsLangue, "")
            FlotteFinal = Replace(FlotteFinal, PonctMdLangue, ",")
            FlotteFinal = FlotteFinal * 1000000000
        End If
        If Right(FlotteFinal, MillionsLangueLenght) = MillionsLangue Then
            FlotteFinal = Replace(FlotteFinal, MillionsLangue, "")
            FlotteFinal = Replace(FlotteFinal, PonctMdLangue, ",")
            FlotteFinal = FlotteFinal * 1000000
        End If
        If Right(Def, MilliardsLangueLenght) = MilliardsLangue Then
            Def = Replace(Def, MilliardsLangue, "")
            Def = Replace(Def, PonctMdLangue, ",")
            Def = Def * 1000000000
        End If
        If Right(Def, MillionsLangueLenght) = MillionsLangue Then
            Def = Replace(Def, MillionsLangue, "")
            Def = Replace(Def, PonctMdLangue, ",")
            Def = Def * 1000000
        End If
        FlotteFinal = Replace(FlotteFinal, PonctMLangue, "")
        Def = Replace(Def, PonctMLangue, "")
        If Def <> "" Then
            Def = Def / 1000
        End If




        FlotteFinal = FlotteFinal / 1000

        'MsgBox ("La flotte est de :" & FlotteFinal & vbNewLine & "La def est de :" & Def)


        ActiveCell.Offset(-3, 11).Select
        ActiveCell.Value = FlotteFinal
        ActiveCell.Offset(0, 1).Value = Def

        FlotteSingle = FlotteFinal
        If Def <> "" Then
            DefSingle = Def
        End If




        '---------------------------------------------------------------------------------------------------------
        'Elimination des defs et flottes ayant un montant supérieur à ce que souhaite le joueur
        'Msgbox d'analyse des données :

        'Flottes :


        If FlotteSingle > Range("Z6").Value Then
            Ligne = ActiveCell.Row
            'MsgBox ("Valeur de la flotte supérieure à celle demandée")
            Range("B" & Ligne & ":Q" & Ligne).Select
            Range("B" & Ligne & ":Q" & Ligne).ClearContents
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorLight1
                .TintAndShade = 0
            End With
        End If
        Ligne = Empty

        'Défenses :
        If DefSingle > Range("Z7").Value Then
            Ligne = ActiveCell.Row
            'MsgBox ("Valeur de la def supérieure à celle demandée")
            Range("B" & Ligne & ":Q" & Ligne).Select
            Range("B" & Ligne & ":Q" & Ligne).ClearContents
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorLight1
                .TintAndShade = 0
            End With
        End If



        '---------------------------------------------------------------------------------------------------------
                                                                    'Recherche de la ligne suivante
        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
        Pourcentage = Pourcentage + 1
        Ligne = ActiveCell.Row
        Range("W37").Value = Ligne / NbLignes * 100
        Application.StatusBar = "Traitement des flottes et défenses  " + CStr([W37]) + "%"
        Pourcentage = 0
    Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
End If

'MsgBox AdresseTrouvee
Set PlageDeRecherche = Nothing
Set Trouve = Nothing


End Sub


Sub ExtractCoordCreationURL()

'Déclaration des variables de recherche :
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String
'Déclaration des variables de mise en forme :
Dim EmplacementG As String, EmplacementSS As String, TempSS As String, EndSS As Integer, EmplacementPos As String, TempPos As Integer, TempG As String
'Variable URL
Dim URLPT As String, URLGT As String
'Numéro de ligne
Dim Compteur As Integer
'Variables utilisateur
Dim http As String, Univers As String
'Déclaration des variables de langue
Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range

'Zone de détection de langue
Langue = Range("Z14").Value
'recherche de la langue
Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)

'vérification de si la langue existe
If TrouveLangue Is Nothing Then
    MsgBox ("Please Set good language in Z4 cell. If your language is not in the table, you can create it by adding it on the list.")
    End
Else
    Range(TrouveLangue.Address).Select
End If

'Affectation des valeurs aux variables
MillionsLangue = ActiveCell.Offset(1, 0).Value
MillionsLangueLenght = Len(MillionsLangue)
MilliardsLangue = ActiveCell.Offset(2, 0).Value
MilliardsLangueLenght = Len(MilliardsLangue)
PonctMLangue = ActiveCell.Offset(3, 0).Value
PonctMdLangue = ActiveCell.Offset(4, 0).Value
RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
FlottesLangue = ActiveCell.Offset(6, 0).Value
DefLangue = ActiveCell.Offset(7, 0).Value
JoueurLangue = ActiveCell.Offset(8, 0).Value
ActiviteLangue = ActiveCell.Offset(9, 0).Value
RessourcesLangue = ActiveCell.Offset(10, 0).Value

'Msgbox De vérification des variables :
'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)



Compteur = 0

'Affectation des valeurs aux variables
Valeur_Cherchee = ":"
'Dans la plage :
Set PlageDeRecherche = ActiveSheet.Range("B2:B5000")

'Utilisation de la méthode Find
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
'MsgBox Trouve

If Trouve Is Nothing Then
    'Dans le cas où la donnée n'est pas trouvée
    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
    'Dans le cas où "Player" est trouvé, exctraction de la coordonnée se trouvant derrière
    PremiereAdresseTrouvee = Trouve.Address
    Do
        AdresseTrouvee = Trouve.Address
        Range(Trouve.Address).Select
        'Galaxie
        EmplacementG = InStr(Trouve, ":")
        TempG = Left(Trouve, EmplacementG - 1)
        EmplacementG = TempG
        'Système Solaire
        EmplacementSS = InStr(Trouve, ":")
        TempSS = Mid(Trouve, EmplacementSS + 1)
        EmplacementPos = TempSS
        EmplacementSS = InStr(TempSS, ":")
        TempSS = Mid(TempSS, 1, EmplacementSS - 1)
        'Position planète
        TempPos = InStr(EmplacementPos, ":")
        EmplacementPos = Mid(EmplacementPos, TempPos + 1)
        'Le MSGBOX suivant permet d'afficher les coords
        'MsgBox (EmplacementG & "." & TempSS & "." & EmplacementPos)

        'Coords stockées dans :
        'EmplacementG = Galaxie
        'TempSS = SS
        'EmplacementPos = Position

        'Récupération de l'univers et de l'http :
        http = Range("Z2").Value
        Univers = Range("Z3").Value

        'Creation URL
        'Exemple d'URL :
        'http://s60-fr.ogame.gameforge.com/game/index.php?page=fleet1&galaxy=2&system=311&position=7&type=1&mission=1&routine=3&am202=1024
        Compteur = Compteur + 1
        URLPT = (http & "://" & Univers & ".ogame.gameforge.com/game/index.php?page=fleet1&galaxy=" & EmplacementG & "&system=" & TempSS & "&position=" & EmplacementPos & "&type=1&mission=1&routine=3&am202=" & ActiveCell.Offset(0, 12).Value)
        'ActiveCell.Offset(0, 9).Value = URLPT
        'Application.ActiveSheet.Hyperlinks.Add(Anchor:="ActiveCell.Offset(0, 9).Address", Address:="URLPT", SubAddress:="", ScreenTip:="Critical", TextToDisplay:="ici")
        ActiveCell.Offset(0, 14).Hyperlinks.Add ActiveCell.Offset(0, 14), URLPT, "", "", URLPT

        URLGT = (http & "://" & Univers & ".ogame.gameforge.com/game/index.php?page=fleet1&galaxy=" & EmplacementG & "&system=" & TempSS & "&position=" & EmplacementPos & "&type=1&mission=1&routine=3&am203=" & ActiveCell.Offset(0, 13).Value)
        ActiveCell.Offset(0, 15).Hyperlinks.Add ActiveCell.Offset(0, 15), URLGT, "", "", URLGT


        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
    Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
End If

'MsgBox AdresseTrouvee
Set PlageDeRecherche = Nothing
Set Trouve = Nothing



End Sub


Sub Statistiques()

'Nettoyage de la zone
Range("W3:W10").Select
Selection.ClearContents

Range("W3").Value = 0
Range("W7").Value = 0
Range("W9").Value = 0

'Somme de la renta de chaque vague
Range("W3").Value = WorksheetFunction.Sum(Range("I2:I" & Range("Z4").Value + 1))
Range("W7").Value = WorksheetFunction.Sum(Range("I" & Range("Z4").Value + 2 & ":I" & Range("Z4").Value * 2 + 1))
Range("W9").Value = WorksheetFunction.Sum(Range("I" & Range("Z4").Value * 2 + 2 & ":I" & Range("Z4").Value * 3 + 1))
'Somme des PT de la première vague
Range("W4").Value = WorksheetFunction.Sum(Range("N2:N" & Range("Z4").Value + 1))
'Moyenne par ina de chaque vague
If Range("W3").Value > 0 Then
    Range("W5").Value = WorksheetFunction.Average(Range("I2:I" & Range("Z4").Value + 1))
End If
If Range("W7").Value > 0 Then
Range("W8").Value = WorksheetFunction.Average(Range("I" & Range("Z4").Value + 2 & ":I" & Range("Z4").Value * 2 + 1))
End If
If Range("W9").Value > 0 Then
Range("W10").Value = WorksheetFunction.Average(Range("I" & Range("Z4").Value * 2 + 2 & ":I" & Range("Z4").Value * 3 + 1))
End If

End Sub

Sub RentaHeure()

'Variables de récupération des données des coords joueur
Dim PlayerCoord As String, PlayerCoordSplit() As String, Galaxie As Integer, Systeme As Integer, Position As Integer
'Variables des variables pour la vitesse des vaisseaux
Dim VitesseUni As Long, Techs As String, TechsSplit() As String, TypeVaisseau As String, Combustion As Integer, Impulsion As Integer, Propulsion As Integer
'Variables de calcul de la vitesse des vaisseaux
Dim VitesseVaisseau As Long
'Variables Diverses
Dim ErrorCode As Integer, NbCells As Integer, NbGalaxies As String, NbSS As String, UniCirculaire As String, TechnoPT As String
'Variables de récupération des coords de destination
Dim DestCoord As String, DestCoordSplit() As String, DestGalaxie As Integer, DestSysteme As Integer, DestPosition As Integer
'Variables de calcul de distance de trajet
Dim GalaxiesTraversees As Integer, SystemesTraverses As Integer, PositionsTraversees As Integer, GalaxiesFinal As Long, SystemesFinal As Long, PositionsFinales As Long
'Variables de calcul du temps de trajet
Dim TempsG As Double, TempsSS As Double, TempsPos As Double
'Variables de calcul de la renta heure
Dim RentaHeureUSM As Single, RentaHeureBrute As Single, ChoixTypeRenta As String
'Déclaration des variables de langue
Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range

'Zone de détection de langue
Langue = Range("Z14").Value
'recherche de la langue
Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)

'vérification de si la langue existe
If TrouveLangue Is Nothing Then
    MsgBox ("Please Set good language in Z4 cell. If your language is not in the table, you can create it by adding it on the list.")
    End
Else
    Range(TrouveLangue.Address).Select
End If

'Affectation des valeurs aux variables
MillionsLangue = ActiveCell.Offset(1, 0).Value
MillionsLangueLenght = Len(MillionsLangue)
MilliardsLangue = ActiveCell.Offset(2, 0).Value
MilliardsLangueLenght = Len(MilliardsLangue)
PonctMLangue = ActiveCell.Offset(3, 0).Value
PonctMdLangue = ActiveCell.Offset(4, 0).Value
RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
FlottesLangue = ActiveCell.Offset(6, 0).Value
DefLangue = ActiveCell.Offset(7, 0).Value
JoueurLangue = ActiveCell.Offset(8, 0).Value
ActiviteLangue = ActiveCell.Offset(9, 0).Value
RessourcesLangue = ActiveCell.Offset(10, 0).Value

'Msgbox De vérification des variables :
'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)


ErrorCode = 0
'Récupération des coordonnées du joueur
PlayerCoord = Range("W17").Value
NbGalaxies = Range("Z9").Value
NbSS = Range("Z10").Value
UniCirculaire = Range("Z11").Value
ChoixTypeRenta = Range("W20").Value
'Séparation de la galaxie, SS et position
PlayerCoordSplit = Split(PlayerCoord, ":")
'MsgBox ("Galaxie : " & PlayerCoordSplit(0) & ", Système solaire : " & PlayerCoordSplit(1) & " et Position : " & PlayerCoordSplit(2))
Galaxie = PlayerCoordSplit(0)
Systeme = PlayerCoordSplit(1)
Position = PlayerCoordSplit(2)

'-----------
'Récupération des paramètres des vaisseaux (techs et type de vaisseau)
VitesseUni = Range("Z8").Value
Techs = Range("W18").Value
TypeVaisseau = Range("W19").Value
'Séparation des 3 technologies des vaisseaux
TechsSplit = Split(Techs, ",")
'MsgBox ("Technologie Combusion : " & TechsSplit(0) & ", Technologie Impulsion : " & TechsSplit(1) & ", Propulsion : " & TechsSplit(2))
Combustion = TechsSplit(0)
Impulsion = TechsSplit(1)
Propulsion = TechsSplit(2)

'Récupération de la vitesse du vaisseau en fonction du type de vaisseau entré
Select Case TypeVaisseau
    Case "PT"
        'MsgBox ("Le type de vaisseau sélectionné est PT")
        VitesseVaisseau = 10000
        If Impulsion >= 5 Then
            VitesseVaisseau = VitesseVaisseau + (VitesseVaisseau * Impulsion * 0.2)
            'MsgBox ("Vitesse via impu : " & VitesseVaisseau)
            TechnoPT = "impu"
        Else
            VitesseVaisseau = VitesseVaisseau + (VitesseVaisseau * Combustion * 0.1)
            'MsgBox ("Vitesse via combu : " & VitesseVaisseau)
            TechnoPT = "combu"
        End If
    Case "GT"
        'MsgBox ("Le type de vaisseau sélectionné est GT")
        VitesseVaisseau = 7500
        VitesseVaisseau = VitesseVaisseau + (VitesseVaisseau * Combustion * 0.1)
        'MsgBox ("Vitesse via combu : " & VitesseVaisseau)
    Case "RIP"
        'MsgBox ("Le type de vaisseau sélectionné est RIP")
        VitesseVaisseau = 100
        VitesseVaisseau = VitesseVaisseau + (VitesseVaisseau * Propulsion * 0.3)
        'MsgBox ("Vitesse via prop : " & VitesseVaisseau)
    Case Else
        MsgBox ("Le type de vaisseau indiqué est incorrect. Merci de choisir entre PT, GT ou RIP")
        ErrorCode = 1
End Select

NbCells = Application.WorksheetFunction.CountA(Range("B2:B5000")) + 1

'Récupération des coordonnées de destination via la boucle FOR
For Each CurCell In Range("B2:B" & NbCells)
    TempsG = 0
    TempsSS = 0
    TempsPos = 0
    RentaHeureBrute = 0
    RentaHeureUSM = 0
    DestCoord = CurCell.Value
    DestCoordSplit = Split(DestCoord, ":")
    DestGalaxie = DestCoordSplit(0)
    DestSysteme = DestCoordSplit(1)
    DestPosition = DestCoordSplit(2)
    'Les coordonnées sont récupérées et séparées en galaxies, SS et Pos
    'MsgBox ("G : " & DestGalaxie & ", SS : " & DestSysteme & ", Pos : " & DestPosition)
    '------------------------------------------------------------------------------------'


    'Calcul de la différence à parcourir
    GalaxiesTraversees = 0
    SystemesTraverses = 0
    PositionsTraversees = 0
    GalaxiesTraversees = Galaxie - DestGalaxie
    SystemesTraverses = Systeme - DestSysteme
    PositionsTraversees = Position - DestPosition
    'Note : à ce stade, il est normal que les valeurs soient erronnées.
    'Elimination des valeurs négatives
    If GalaxiesTraversees < 0 Then
        GalaxiesTraversees = GalaxiesTraversees * -1
    End If
    If SystemesTraverses < 0 Then
        SystemesTraverses = SystemesTraverses * -1
    End If
    If PositionsTraversees < 0 Then
        PositionsTraversees = PositionsTraversees * -1
    End If
    'MsgBox ("Le nombre de galaxies traversées à ce stade de " & GalaxiesTraversees & ", le nombre de ss traversés est de " & SystemesTraverses & " et le nombre de positions est de " & PositionsTraversees)
    'La boucle vérifie d'abord si la distance est de plus de 0 galaxies puis de 5, puis vérifie si ensuite la distance est de plus de un ss pour finir sur les positions
    If GalaxiesTraversees <> 0 Then
        Select Case UniCirculaire
            Case "Oui"
                'Si GalaxiesTraversees est plus grand que la moitié de la taille de l'uni, ça signifie qu'il faut passer par le bout de l'uni (unis circulaires)
                If GalaxiesTraversees > NbGalaxies / 2 Then
                    'MsgBox ("Le nombre de galaxies à traverser est supérieur à la moitié de l'uni")
                    'Reset de galaxiestraversees, qui sera utilisée dans la suite
                    GalaxiesTraversees = 0
                    'Vérification de si la galaxie initiale est plus haute que la galaxie de destination
                    If Galaxie > DestGalaxie Then
                        GalaxiesTraversees = NbGalaxies + DestGalaxie
                        GalaxiesFinal = GalaxiesTraversees - Galaxie
                        'MsgBox ("Le nombre de galaxies à traverser est supérieur à la moitié de l'uni | Solution 1  " & GalaxiesFinal & " | Galaxie de destination : " & DestGalaxie)
                    ElseIf Galaxie < DestGalaxie Then
                        GalaxiesTraversees = NbGalaxies - DestGalaxie
                        GalaxiesFinal = GalaxiesTraversees + Galaxie
                        'MsgBox ("Le nombre de galaxies à traverser est supérieur à la moitié de l'uni | Solution 2  " & GalaxiesFinal & " | Galaxie de destination : " & DestGalaxie)
                    End If
                Else
                    GalaxiesFinal = GalaxiesTraversees
                    'MsgBox ("Le nombre de galaxies à traverser est inférieur ou égal à la moitié de l'uni, nombre de galaxies traversées : " & GalaxiesFinal & " | Galaxie de destination : " & DestGalaxie)
                End If
            Case "Non"
                If Galaxie > DestGalaxie Then
                    GalaxiesTraversees = 0
                    GalaxiesTraversees = Galaxie - DestGalaxie
                    GalaxiesFinal = GalaxiesTraversees
                    'MsgBox ("Solution 1  " & GalaxiesFinal & " | Galaxie de destination : " & DestGalaxie)
                ElseIf Galaxie < DestGalaxie Then
                    GalaxiesTraversees = DestGalaxie - Galaxie
                    GalaxiesFinal = GalaxiesTraversees
                    'MsgBox ("Solution 2  " & GalaxiesFinal & " | Galaxie de destination : " & DestGalaxie)
                End If
            Case Else
                MsgBox ("Merci d'entrer une valeur correcte (Oui ou Non) pour la case S11")
        End Select
        'Calcul du temps de trajet interG ICI :
        '---
        TempsG = (10 + (35000 / 100 * Sqr((GalaxiesFinal * 20000) * 1000 / VitesseVaisseau))) / VitesseUni
        'Il faut compter le retour
        TempsG = TempsG * 2
        'MsgBox ("Le temps de trajet pour ce voyage de " & GalaxiesFinal & "galaxies en secondes est de : " & TempsG)
        'Il faut convertir en heures
        TempsG = TempsG / 3600
        'MsgBox TempsG
        'Calcul des renta heure
        'Cherche la Renta avec curcell.offset
        RentaHeureBrute = CurCell.Offset(0, 7).Value / TempsG
        'MsgBox RentaHeureBrute
        RentaHeureUSM = CurCell.Offset(0, 8).Value / TempsG
        '---
    'Ici se termine le cas dans lequel le voyage dure plus de une galaxie
    Else
        'Gestion des systèmes solaires
        If SystemesTraverses <> 0 Then
            Select Case UniCirculaire
                Case "Oui"
                    'Si SystemesTraverses est plus grand que la moitié de la taille du SS, ça signifie qu'il faut passer par le bout du SS (unis circulaires)
                    If SystemesTraverses > NbSS / 2 Then
                        'MsgBox ("Le nombre de SS à traverser est supérieur à la moitié du SS")
                        'Reset de systemestraverses, qui sera utilisée par la suite
                        SystemesTraverses = 0
                        'Vérification de si le système de départ est plus haut ou plus bas que le ss de destination
                        If Systeme > DestSysteme Then
                            SystemesTraverses = NbSS + DestSysteme
                            SystemesFinal = SystemesTraverses - Systeme
                            'MsgBox ("Le nombre de SS à traverser est supérieur à la moitié de la galaxie | Solution 1  " & SystemesFinal & " | Systeme de destination : " & DestSysteme)
                        ElseIf Systeme < DestSysteme Then
                            SystemesTraverses = NbSS - DestSysteme
                            SystemesFinal = SystemesTraverses + Systeme
                            'MsgBox ("Le nombre de SS à traverser est supérieur à la moitié de la galaxie | Solution 2  " & SystemesFinal & " | Systeme de destination : " & DestSysteme)
                        End If
                    Else
                        SystemesFinal = SystemesTraverses
                        'MsgBox ("Le nombre de SS à traverser est inférieur ou égal à la moitié de la galaxie, nombre de SS traversés : " & SystemesFinal & " | Systeme de destination : " & DestSysteme)
                    End If
                Case "Non"
                    If Systeme > DestSysteme Then
                        SystemesTraverses = 0
                        SystemesTraverses = Systeme - DestSysteme
                        SystemesFinal = SystemesTraverses
                        'MsgBox ("Solution 1  " & SystemesFinal & " | Systeme de destination : " & DestSysteme)
                    ElseIf Systeme < DestSysteme Then
                        SystemesTraverses = DestSysteme - Systeme
                        SystemesFinal = SystemesTraverses
                        'MsgBox ("Solution 2  " & SystemesFinal & " | Système de destination : " & DestSysteme)
                    End If

                Case Else
                    MsgBox ("Merci d'entrer une valeur correcte (Oui ou Non) pour la case S11")
            End Select
            'Calcul du temps de trajet interSS ICI :
            '---
            TempsSS = (10 + 35000 / 100 * Sqr((2700 + 95 * SystemesFinal) * 1000 / VitesseVaisseau)) / VitesseUni
            'MsgBox ("Le temps de trajet pour ce voyage de " & SystemesFinal & "SS en secondes est de : " & TempsSS)
            'Il faut compter le retour
            TempsSS = TempsSS * 2
            'Il faut convertir en heures
            TempsSS = TempsSS / 3600
            'Calcul des renta heure
            'Cherche la Renta avec curcell.offset
            RentaHeureBrute = CurCell.Offset(0, 7).Value / TempsSS
            'MsgBox RentaHeureBrute
            RentaHeureUSM = CurCell.Offset(0, 8).Value / TempsSS
            '---
            'fin de gestion des systèmes solaires
        Else
            'calcul du nombre de positions à traverser
            'note : les ss ne sont pas circulaires
            If PositionsTraversees <> 0 Then
                If Position > DestPosition Then
                    PositionsTraversees = 0
                    PositionsTraversees = Position - DestPosition
                    PositionsFinales = PositionsTraversees
                    'MsgBox ("Le nombre de positions traversées - solution 1 - est de : " & PositionsFinales)
                ElseIf Position < DestPosition Then
                    PositionsTraversees = DestPosition - Position
                    PositionsFinales = PositionsTraversees
                    'MsgBox ("Le nombre de positions traversées - solution 2 - est de : " & PositionsFinales)
                End If
                'Calcul du temps de trajet pour un trajet dans le même SS :
                TempsPos = (10 + ((35000 / 100) * Sqr((1000 + 5 * PositionsFinales) * 1000 / VitesseVaisseau))) / VitesseUni
                'MsgBox ("Le temps de trajet pour ce voyage de " & PositionsFinales & "positions en secondes est de : " & TempsPos)
                'Il faut compter le retour
                TempsPos = TempsPos * 2
                'Il faut convertir en heures
                TempsPos = TempsPos / 3600
                'Calcul des renta heure
                'Cherche la Renta avec curcell.offset
                RentaHeureBrute = CurCell.Offset(0, 7).Value / TempsPos
                'MsgBox RentaHeureBrute
                RentaHeureUSM = CurCell.Offset(0, 8).Value / TempsPos


            End If
        End If
    End If

    'Choix du type de renta à afficher en fonction des choix de l'utilisateur
    Select Case ChoixTypeRenta
        Case "Brute"
            CurCell.Offset(0, 9).Value = RentaHeureBrute
        Case "USM"
            CurCell.Offset(0, 9).Value = RentaHeureUSM
        Case Else
            MsgBox ("Merci d'indiquer Brute ou USM dans la case P20")
    End Select
Next

'Modification de l'intitulé de la colonne de rentahoraire en fonction des choix de l'utilisateur

Select Case ChoixTypeRenta
    Case "Brute"
        Range("K1").Value = "Profits/Heure Brute"
    Case "USM"
        Range("K1").Value = "Profits/Heure USM"
    Case Else
        MsgBox ("Merci d'indiquer Brute ou USM dans la case W20")
End Select



End Sub

Sub BoutonPT(BtnName As String)
'Macro affectée aux Boutons PT, elle récupère le nom du bouton créé avec create_buttons, utilise les liens et colorise les cases

    BtnName = BtnName + 1
    'MsgBox BtnName
    Set objWSH = CreateObject("WScript.Shell")
        Call objWSH.Run("""" & Range("P" & BtnName).Value & """")
    Range("P" & BtnName).Select
        With Selection.Interior
            .Pattern = xlUp
            .PatternThemeColor = xlThemeColorAccent3
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.599963377788629
            .PatternTintAndShade = 0.399945066682943
        End With
    Set objWSH = Nothing
End Sub
Sub BoutonGT(BtnName As String)
'Macro affectée aux Boutons GT, elle récupère le nom du bouton créé avec create_buttons, utilise les liens et colorise les cases

    BtnName = BtnName + 1
    'MsgBox BtnName
    Set objWSH = CreateObject("WScript.Shell")
        Call objWSH.Run("""" & Range("Q" & BtnName).Value & """")
    Range("Q" & BtnName).Select
        With Selection.Interior
            .Pattern = xlUp
            .PatternThemeColor = xlThemeColorAccent3
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.599963377788629
            .PatternTintAndShade = 0.399945066682943
        End With
    Set objWSH = Nothing
End Sub

Sub create_buttons()
'Cette macro est utilisée pour créer les boutons en colonne T et U

Dim I As Integer
Dim J As Integer
Dim Btn As Button
Dim Text As String

I = 2



ActiveSheet.Buttons.Delete
'ButtonPT
For I = 2 To 600
    'Ival = "T" & I
    Set Btn = ActiveSheet.Buttons.Add(Range("T" & I).Left, Range("T" & I).Top, Range("T" & I).Width, Range("T" & I).Height)
    Btn.Name = I - 1
    'Lance la macro BoutonPT et envoie dans celle-ci le nom du bouton
    Btn.OnAction = "'BoutonPT """ & Btn.Name & """'"
    Btn.Text = "PT" & Btn.Name
    Text = Btn.Name
Next

Set Btn = Nothing
'ButtonGT
For I = 2 To 600
    'Ival = "T" & I
    Set Btn = ActiveSheet.Buttons.Add(Range("U" & I).Left, Range("U" & I).Top, Range("U" & I).Width, Range("U" & I).Height)
    Btn.Name = I - 1
    'Lance la macro BoutonGT et envoie dans celle-ci le nom du bouton
    Btn.OnAction = "'BoutonGT """ & Btn.Name & """'"
    Btn.Text = "GT" & Btn.Name
    Text = Btn.Name
Next

Set Btn = Nothing

'Others Buttons :
'Create Board
Set Btn = ActiveSheet.Buttons.Add(Range("V25:W25").Left, Range("V25:W25").Top, Range("V25:W25").Width, Range("V25:W25").Height)
Btn.Text = "Créer Tableau / Create Board (Ctrl+B)"
Btn.OnAction = "'TriRenta'"
Set Btn = Nothing
'Switch FR/EN
Set Btn = ActiveSheet.Buttons.Add(Range("AB20").Left, Range("AB20").Top, Range("AB20").Width, Range("AB20").Height)
Btn.Text = "Switch FR/EN"
Btn.OnAction = "'LanguageButton'"
Set Btn = Nothing
'Remove Buttons
Set Btn = ActiveSheet.Buttons.Add(Range("AB22").Left, Range("AB22").Top, Range("AB22").Width, Range("AB22").Height)
Btn.Text = "Remove Buttons"
Btn.OnAction = "'Remove_Buttons'"

End Sub

Sub Remove_Buttons()

'This sub is useful if you want to remove buttons (to use the table in a program that doesn't read buttons)
ActiveSheet.Buttons.Delete

End Sub



Sub LanguageButton()

'Cette Macro est affectée au Bouton "SwitchLanguage"

Dim Langue As String

Langue = Range("Z14").Value

Select Case Langue
    Case "FR"
        'Configuration
        Range("Y1").Value = "|-- Configuration --|"
        Range("Y2").Value = "Http ou Https ?"
        Range("Y3").Value = "Univers : (ex : s60-fr)"
        Range("Y4").Value = "Nombre de Slots"
        Range("Y5").Value = "Minimum pour créer une 2nd vague"
        Range("Y6").Value = "Supprimer les flottes dont la valeur dépasse en points…"
        Range("Y7").Value = "Supprimer les Défenses dont la valeur dépasse en points…"
        Range("Y8").Value = "Vitesse flotte de l'univers (mettre 1,2 ou 3 ou 4…)"
        Range("Y9").Value = "Nombre de galaxies dans l'univers"
        Range("Y10").Value = "Nombre de systèmes solaires dans l'univers"
        Range("Y11").Value = "Univers Circulaire ? Répondre par Oui ou Non"
        Range("Y12").Value = "Combien de fois plus de vaisseaux que nécessaire ?** "
        Range("Y13").Value = "Trier les ressources en fonction de la colonne… (ex : F)"
        Range("Y14").Value = "Langue"

        'Statistiques
        Range("V1").Value = "|- Statistiques -|"
        Range("V3").Value = "Total de la première vague : "
        Range("V4").Value = "PT nécessaires (1ère vague)"
        Range("V5").Value = "Moyenne par raid  : "
        Range("V7").Value = "Total seconde vague :"
        Range("V8").Value = "Moyenne par raid (2nd vague ) : "
        Range("V9").Value = "Total 3e vague :"
        Range("V10").Value = "Moyenne par raid (3ème vague ):"
        Range("V13").Value = "Moyenne par raid (total des RE) :"
        Range("V14").Value = "Nombre Total de RE : "

        'Sous les statistiques

        Range("V17").Value = "Coordonnée de départ (ex : 9:158:3) :"
        Range("V18").Value = "Techs (combu,impu,prop)  *"
        Range("V19").Value = "Entrer PT ou GT ou RIP *** "
        Range("V20").Value = "Renta horaire (Entrer Brute ou USM) "
        Range("V21").Value = "Taux de commerce (Pour l'USM)"

        'Tableau
        Range("C1").Value = "Joueur"
        Range("D1").Value = "Ressources"
        Range("E1").Value = "Métal"
        Range("F1").Value = "Cristal"
        Range("G1").Value = "Deutérium"
        Range("I1").Value = "Rentabilité"
        Range("J1").Value = "Renta USM"
        Range("L1").Value = "Flotte"
        Range("M1").Value = "Défense"
        Range("N1").Value = "NbPT"
        Range("O1").Value = "NbGT"
        Range("P1").Value = "Lien PT"
        Range("Q1").Value = "Lien GT"
        Range("S1").Value = "Lancé?"

    Case Else

        'Configuration
        Range("Y1").Value = "|-- Options --|"
        Range("Y2").Value = "Http or Https ?"
        Range("Y3").Value = "Universe : (ex : s60-fr)"
        Range("Y4").Value = "Amount of fleet slots"
        Range("Y5").Value = "Minimum profits to create a next wave"
        Range("Y6").Value = "Delete the line when the fleet amount is higher than... (amount /1000) "
        Range("Y7").Value = "Delete the line when the def amount is higher than... (amount /1000)"
        Range("Y8").Value = "Fleet speed of the universe (put 1, or 2, or 3...)"
        Range("Y9").Value = "Amount of galaxies in your universe"
        Range("Y10").Value = "Amount of solar systems per galaxies"
        Range("Y11").Value = "Circular Universe ? Choose Oui or Non "
        Range("Y12").Value = "How many more ships do you want to send?** "
        Range("Y13").Value = "Sort the table with column… (ex : F)"
        Range("Y14").Value = "Language"

        'Statistiques
        Range("V1").Value = "|- Stats -|"
        Range("V3").Value = "Profits in first wave : "
        Range("V4").Value = "Light Cargos (1st wave)"
        Range("V5").Value = "Average per attack  : "
        Range("V7").Value = "Profits in second wave :"
        Range("V8").Value = "Average per attack (2nd wave) : "
        Range("V9").Value = "Profits in 3rd wave :"
        Range("V10").Value = "Average per attack (3rd wave):"
        Range("V13").Value = "Average per attack (For all SR) :"
        Range("V14").Value = "Amount of Spy Reports : "

        'Sous les statistiques

        Range("V17").Value = "Your coords (ex : 9:158:3) :"
        Range("V18").Value = "Speed of your ships (combu,impu,hyper)  *"
        Range("V19").Value = "Enter PT or GT or RIP *** "
        Range("V20").Value = "Profits/ hour (Enter Brute or USM) "
        Range("V21").Value = "Trade Rate (for USM)"

        'Tableau
        Range("C1").Value = "Player"
        Range("D1").Value = "Resources"
        Range("E1").Value = "Metal"
        Range("F1").Value = "Crystal"
        Range("G1").Value = "Deuterium"
        Range("I1").Value = "Profits"
        Range("J1").Value = "Profits USM"
        Range("L1").Value = "Fleet"
        Range("M1").Value = "Defence"
        Range("N1").Value = "Amount Light Cargo"
        Range("O1").Value = "Amount Large Cargo"
        Range("P1").Value = "Link Light C"
        Range("Q1").Value = "Link Large C"
        Range("S1").Value = "Launched?"



End Select




End Sub





Sub ColorAttack()

'Cette macro, affectée à un raccourci permet de colorier n'importe quelle case de l'excel en vert. Utile pour se repérer dans les pillages.

Range(ActiveCell.Address).Select
            With Selection.Interior
                .Pattern = xlUp
                .PatternThemeColor = xlThemeColorAccent3
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.599963377788629
                .PatternTintAndShade = 0.399945066682943
            End With

End Sub