oddwh

RaiderTab SourceCode 6.0.20.2

Feb 15th, 2016
2,205
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub TriRenta()
  2.  
  3. 'Cette Macro est la macro principale générant le tableau. Elle appelle toutes les autres
  4. 'This Macro is the main Macro that generates the board. You have to launch this Macro to generate the board
  5.  
  6. Dim Plage As Range, LigneCoords As Range
  7. Dim LigneCoordTrouvee As String, PremiereLigneTrouvee As String
  8. Dim NbCells As Integer, CurCell As Object, ActiveLine As Integer
  9. 'Variables de calcul GT et PT :
  10. Dim NbPT As Long, NbGT As Long
  11. 'Variable Bouton
  12. Dim Btn As Button, t As Range
  13. 'Comptage du nombre de vagues
  14. Dim NbVagues As Integer
  15. 'Récupération de la quantité de gains nécessaires pour créer une seconde vague
  16. Dim RentaUser As Long
  17. 'Variable permettant d'envoyer plus de PT que nécessaire
  18. 'Allow More Cargos than necessary
  19. Dim PTMore As String
  20. 'Déclaration des variables de langue
  21. 'Language Variables
  22. Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
  23. Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
  24. Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range
  25.  
  26.  
  27. Application.ScreenUpdating = False
  28. 'Zone de détection de langue
  29. Langue = Range("Z14").Value
  30. 'recherche de la langue
  31. Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
  32. Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)
  33.  
  34. 'vérification de si la langue existe
  35. 'Check if language exists
  36. If TrouveLangue Is Nothing Then
  37.     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.")
  38.     End
  39. Else
  40.     Range(TrouveLangue.Address).Select
  41. End If
  42.  
  43. 'Affectation des valeurs aux variables
  44. 'Affecting value to variables
  45. MillionsLangue = ActiveCell.Offset(1, 0).Value
  46. MillionsLangueLenght = Len(MillionsLangue)
  47. MilliardsLangue = ActiveCell.Offset(2, 0).Value
  48. MilliardsLangueLenght = Len(MilliardsLangue)
  49. PonctMLangue = ActiveCell.Offset(3, 0).Value
  50. PonctMdLangue = ActiveCell.Offset(4, 0).Value
  51. RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
  52. FlottesLangue = ActiveCell.Offset(6, 0).Value
  53. DefLangue = ActiveCell.Offset(7, 0).Value
  54. JoueurLangue = ActiveCell.Offset(8, 0).Value
  55. ActiviteLangue = ActiveCell.Offset(9, 0).Value
  56. RessourcesLangue = ActiveCell.Offset(10, 0).Value
  57.  
  58. 'Msgbox De vérification des variables :
  59. 'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66. NbVagues = 1
  67. PTMore = Range("Z12").Value
  68. RentaUser = Range("Z5").Value * 2
  69. Set Plage = ActiveSheet.Range("B2:B5000")
  70.  
  71. '----------------------------------------------------------
  72. 'décolorisation de la plage
  73. '
  74. 'cleaning colors of the selected range
  75. Range("A2:Q5000").Select
  76. With Selection.Interior
  77.     .Pattern = xlNone
  78.     .TintAndShade = 0
  79.     .PatternTintAndShade = 0
  80. End With
  81. With Selection.Font
  82.     .ThemeColor = xlThemeColorLight1
  83.     .TintAndShade = 0
  84. End With
  85.  
  86.  
  87. 'Nettoyage de la zone de tri
  88. 'cleaning contents in selected range
  89. Range("B2:Q5000").Select
  90. Selection.ClearContents
  91.  
  92. 'MsgBox ("a")
  93. '-----------------------------------------------------------
  94.  
  95. 'Appel des Sub
  96. 'calling others macros
  97. Call ChercheJoueurs
  98. Call ChercheCoords
  99. Call ChercheLoot
  100. Call ChercheRessourcesNew
  101. Call ChercheDefsFeets
  102.  
  103. '-----------------------------------------------------------
  104.  
  105. 'Recherche des lignes contenant des coordonnées
  106. 'Searching lines containing coords
  107.  
  108. Application.StatusBar = "Création des données du tableau..."
  109. Set LigneCoords = Plage.Cells.Find(what:=":", LookAt:=xlPart)
  110. If LigneCoords Is Nothing Then
  111.     'Dans le cas où aucune coord n'est trouvée
  112.    'If no coords are found
  113.    LigneCoordTrouvee = "Aucune Coordonnée n'est présente dans la plage " & Plage.Address
  114. Else
  115.     'Dans le cas où une coordonnée est trouvée, traitement des infos lui étant associées
  116.    'If a coord is found, it launches calculation of associated datas
  117.    PremiereLigneTrouvee = LigneCoords.Address
  118.     Do
  119.         LigneCoordTrouvee = LigneCoords.Address
  120.         Range(LigneCoords.Address).Select
  121.         'Calcul de la renta finale
  122.        ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(0, 2) * ActiveCell.Offset(0, 6)
  123.         '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 :
  124.        'this parts create others waves, when the amount of profit is more than what wished user
  125.        If ActiveCell.Offset(0, 7).Value >= RentaUser Then
  126.             If ActiveCell.Offset(0, 6).Value <= 0.75 Then
  127.                 If NbVagues < 6 Then
  128.                     ActiveCell.Offset(1, 0).Value = ActiveCell.Value
  129.                     ActiveCell.Offset(1, 1).Value = ActiveCell.Offset(0, 1).Value
  130.                     ActiveCell.Offset(1, 2).Value = ActiveCell.Offset(0, 2).Value * (1 - ActiveCell.Offset(0, 6).Value)
  131.                     ActiveCell.Offset(1, 3).Value = ActiveCell.Offset(0, 3).Value * (1 - ActiveCell.Offset(0, 6).Value)
  132.                     ActiveCell.Offset(1, 4).Value = ActiveCell.Offset(0, 4).Value * (1 - ActiveCell.Offset(0, 6).Value)
  133.                     ActiveCell.Offset(1, 5).Value = ActiveCell.Offset(0, 5).Value * (1 - ActiveCell.Offset(0, 6).Value)
  134.                     ActiveCell.Offset(1, 6).Value = ActiveCell.Offset(0, 6).Value
  135.                     ActiveCell.Offset(1, 8).Value = ActiveCell.Offset(0, 8).Value * (1 - ActiveCell.Offset(0, 6).Value)
  136.                     ActiveCell.Offset(1, 10).Value = ActiveCell.Offset(0, 10).Value
  137.                     ActiveCell.Offset(1, 11).Value = ActiveCell.Offset(0, 11).Value
  138.  
  139.                     'Colorisation de la seconde vague en jaune
  140.                    'Next wave = yellow in coords
  141.                    With ActiveCell.Offset(1, 0).Interior
  142.                         .Pattern = xlUp
  143.                         .PatternColor = 65535
  144.                         .Color = 49407
  145.                         .TintAndShade = 0
  146.                         .PatternTintAndShade = 0
  147.                     End With
  148.                     'MsgBox ("Vague crée")
  149.                    NbVagues = NbVagues + 1
  150.                 End If
  151.             End If
  152.         Else
  153.             NbVagues = 1
  154.         End If
  155.         'MsgBox NbVagues
  156.        'Calcul du nombre de PT et GT
  157.        ActiveCell.Offset(0, 7).Select
  158.         NbPT = ActiveCell.Value / 5000 * PTMore
  159.         ActiveCell.Offset(0, 5).Value = NbPT
  160.         NbGT = ActiveCell.Value / 25000 * PTMore
  161.         ActiveCell.Offset(0, 6).Value = NbGT
  162.         'Comptage du Nombre de RE donnés à l'excel
  163.        Set LigneCoords = Plage.Cells.FindNext(LigneCoords)
  164.     Loop While Not LigneCoords Is Nothing And LigneCoords.Address <> PremiereLigneTrouvee
  165.     ' Tri des lignes afin de les ramener tout en haut
  166.    Range("B2:Q5000").Sort Key1:=Range("I1"), Order1:=xlDescending
  167.     'Appel de la fonction de renta heure
  168.    Call RentaHeure
  169.     'Second tri
  170.    Range("B2:Q5000").Sort Key1:=Range(Range("Z13").Value & "1"), Order1:=xlDescending
  171.     'Comptage du nombre de lignes contenant une coordonnée
  172.    NbCells = Application.WorksheetFunction.CountA(Range("B2:B5000"))
  173.     '
  174.    '---------------------------------------------------------------------------------------
  175.    'Colorisation des flottes et défenses
  176.    Application.StatusBar = "Colorisation..."
  177.     For Each CurCell In Range("L2:M" & NbCells + 1)
  178.         If CurCell.Value > 0 Then
  179.             Range(CurCell.Address).Select
  180.             With Selection.Interior
  181.                 .Pattern = xlUp
  182.                 .PatternColor = 999
  183.                 .Color = 126
  184.                 .TintAndShade = 0
  185.                 .PatternTintAndShade = 0
  186.             End With
  187.             With Selection.Font
  188.                 .ThemeColor = xlThemeColorDark1
  189.                 .TintAndShade = 0
  190.             End With
  191.         End If
  192.         If CurCell.Value = 0 Then
  193.             Range(CurCell.Address).Select
  194.             With Selection.Interior
  195.                 .Pattern = xlUp
  196.                 .PatternThemeColor = xlThemeColorAccent3
  197.                 .ThemeColor = xlThemeColorAccent3
  198.                 .TintAndShade = 0.599963377788629
  199.                 .PatternTintAndShade = 0.399945066682943
  200.             End With
  201.         End If
  202.         If CurCell.Value = "" Then
  203.             Range(CurCell.Address).Select
  204.             With Selection.Interior
  205.                 .Pattern = xlUp
  206.                 .PatternColor = 65535
  207.                 .Color = 49407
  208.                 .TintAndShade = 0
  209.                 .PatternTintAndShade = 0
  210.             End With
  211.         End If
  212.     Next
  213.     '-----------------------------------------------------------------------
  214.    'Colorisation des renta
  215.    For Each CurCell In Range("I2:I" & NbCells + 1)
  216.         If CurCell.Value > 1500000 Then
  217.             Range(CurCell.Address).Select
  218.             Range("I" & ActiveCell.Row & ":K" & ActiveCell.Row).Select
  219.             With Selection.Interior
  220.                 .Pattern = xlUp
  221.                 .PatternThemeColor = xlThemeColorAccent3
  222.                 .ThemeColor = xlThemeColorAccent3
  223.                 .TintAndShade = 0.599963377788629
  224.                 .PatternTintAndShade = 0.399945066682943
  225.             End With
  226.             Range("D" & ActiveCell.Row & ":G" & ActiveCell.Row).Select
  227.             With Selection.Interior
  228.                 .Pattern = xlUp
  229.                 .PatternThemeColor = xlThemeColorAccent3
  230.                 .ThemeColor = xlThemeColorAccent3
  231.                 .TintAndShade = 0.599963377788629
  232.                 .PatternTintAndShade = 0.399945066682943
  233.             End With
  234.         End If
  235.         If CurCell.Value < 750000 Then
  236.             Range(CurCell.Address).Select
  237.             Range("I" & ActiveCell.Row & ":K" & ActiveCell.Row).Select
  238.             With Selection.Interior
  239.                 .Pattern = xlUp
  240.                 .PatternThemeColor = xlThemeColorAccent6
  241.                 .ThemeColor = xlThemeColorAccent6
  242.                 .TintAndShade = -0.249946592608417
  243.                 .PatternTintAndShade = -0.499984740745262
  244.             End With
  245.             With Selection.Font
  246.                 .ThemeColor = xlThemeColorDark1
  247.                 .TintAndShade = 0
  248.             End With
  249.             Range("D" & ActiveCell.Row & ":G" & ActiveCell.Row).Select
  250.             With Selection.Interior
  251.                 .Pattern = xlUp
  252.                 .PatternThemeColor = xlThemeColorAccent6
  253.                 .ThemeColor = xlThemeColorAccent6
  254.                 .TintAndShade = -0.249946592608417
  255.                 .PatternTintAndShade = -0.499984740745262
  256.             End With
  257.             With Selection.Font
  258.                 .ThemeColor = xlThemeColorDark1
  259.                 .TintAndShade = 0
  260.             End With
  261.         End If
  262.     Next
  263.     'Création de l'URL
  264.    '-----------------------------------
  265.    Call ExtractCoordCreationURL
  266.    
  267.            
  268. End If
  269.  
  270. Call Statistiques
  271. Range("P2").Select
  272. If Range("W5").Value > 1000000 Then
  273.     If Range("W5").Value < 2000000 Then
  274.         Application.StatusBar = "Génération du tableau terminée ! :)"
  275.     Else
  276.         Application.StatusBar = "Génération du tableau terminée ! Jolis pillages en perspective, Enjoy :)"
  277.     End If
  278. End If
  279. If Range("W5").Value < 1000000 Then
  280.         Application.StatusBar = "Génération du tableau terminée ! Pas terrible cette vague :/"
  281. End If
  282.    
  283.  
  284.    
  285.  
  286. End Sub
  287.  
  288.  
  289. Sub ChercheJoueurs()
  290. 'Déclaration des variables de recherche :
  291. Dim Trouve As Range, PlageDeRecherche As Range, TrouveSplit() As String
  292. Dim Valeur_Cherchee As String, AdresseTrouvee As String, PremiereAdresseTrouvee As String
  293. 'Déclaration des variables d'extraction de ressources :
  294. Dim TempPlayer As String, EmplacementPlayer As String, EmplacementPlayerSplit As String, Parentheses As String, SplitPlayer As String, Activite As String, EmplacementPlayerSplitTwo() As String
  295. 'Déclaration des variables de la barre de progression
  296. Dim Pourcentage As Long, NbLignes As Long, Ligne As Long
  297. 'Déclaration de la variable permettant de compter le nombre de RE
  298. Dim NombreRE As Integer
  299. 'Déclaration des variables de langue
  300. Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
  301. Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
  302. Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range
  303.  
  304. 'Zone de détection de langue
  305. Langue = Range("Z14").Value
  306. 'recherche de la langue
  307. Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
  308. Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)
  309.  
  310. 'vérification de si la langue existe
  311. If TrouveLangue Is Nothing Then
  312.     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.")
  313.     End
  314. Else
  315.     Range(TrouveLangue.Address).Select
  316. End If
  317.  
  318. 'Affectation des valeurs aux variables
  319. MillionsLangue = ActiveCell.Offset(1, 0).Value
  320. MillionsLangueLenght = Len(MillionsLangue)
  321. MilliardsLangue = ActiveCell.Offset(2, 0).Value
  322. MilliardsLangueLenght = Len(MilliardsLangue)
  323. PonctMLangue = ActiveCell.Offset(3, 0).Value
  324. PonctMdLangue = ActiveCell.Offset(4, 0).Value
  325. RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
  326. FlottesLangue = ActiveCell.Offset(6, 0).Value
  327. DefLangue = ActiveCell.Offset(7, 0).Value
  328. JoueurLangue = ActiveCell.Offset(8, 0).Value
  329. ActiviteLangue = ActiveCell.Offset(9, 0).Value
  330. RessourcesLangue = ActiveCell.Offset(10, 0).Value
  331.  
  332. 'Msgbox De vérification des variables :
  333. 'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)
  334.  
  335.  
  336.  
  337. 'Affecation des valeurs aux variables :
  338. 'Application.ScreenUpdating = False
  339. Valeur_Cherchee = JoueurLangue
  340.  
  341. Pourcentage = 0
  342. NombreRE = 0
  343. Range("W37").Value = 0
  344.  
  345. 'Comptage du nombre de lignes
  346. NbLignes = Cells(Rows.Count, 1).End(xlUp).Row
  347. 'Dans la plage :
  348. Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")
  349.  
  350. 'Recherche de la ligne "Joueur"
  351. Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
  352.  
  353. 'MsgBox Trouve
  354.  
  355. If Trouve Is Nothing Then
  356.     'Dans le cas où la donnée n'est pas trouvée
  357.    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
  358. Else
  359.     'Dans le cas où "Joueur"/"Player" est trouvé, exctraction de la coordonnée se trouvant derrière
  360.    PremiereAdresseTrouvee = Trouve.Address
  361.     Do
  362.         AdresseTrouvee = Trouve.Address
  363.         NombreRE = NombreRE + 1
  364.         Range(Trouve.Address).Select
  365.         TrouveSplit = Split(Trouve, ":")
  366.         EmplacementPlayer = TrouveSplit(1)
  367.         'MsgBox ("|" & EmplacementPlayer & "|")
  368.        
  369.        
  370.         EmplacementPlayer = Replace(EmplacementPlayer, ActiviteLangue, "")
  371.         'MsgBox ("|" & EmplacementPlayer & "|")
  372.        EmplacementPlayerSplitTwo = Split(EmplacementPlayer, "(")
  373.         SplitPlayer = EmplacementPlayerSplitTwo(0)
  374.         SplitPlayer = Mid(SplitPlayer, 3)
  375.         'MsgBox ("|" & SplitPlayer & "|")
  376.  
  377.         ActiveCell.Offset(0, 2).Value = SplitPlayer
  378.    
  379.         'Recherche de la prochaine ligne
  380.        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
  381.         Ligne = ActiveCell.Row
  382.         Range("W37").Value = Ligne / NbLignes * 100
  383.         Application.StatusBar = "Traitement des pseudos  " + CStr([W37]) + "%"
  384.     Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
  385. End If
  386.  
  387. 'MsgBox AdresseTrouvee
  388. 'Vidage des variables
  389. Range("W14").Value = NombreRE
  390. Set PlageDeRecherche = Nothing
  391. Set Trouve = Nothing
  392. End Sub
  393.  
  394. Sub ChercheCoords()
  395. 'Déclaration des variables de recherche :
  396. Dim Trouve As Range, PlageDeRecherche As Range
  397. Dim Valeur_Cherchee As String, AdresseTrouvee As String, PremiereAdresseTrouvee As String
  398. 'Déclaration des variables d'extraction de ressources :
  399. Dim TempCoord As String, EmplacementCoord As String, EmplacementFinCoord As String
  400. Dim Pourcentage As Long, NbLignes As Long, Ligne As Long
  401.  
  402. 'Déclaration des variables de langue
  403. Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
  404. Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
  405. Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range
  406.  
  407. 'Zone de détection de langue
  408. Langue = Range("Z14").Value
  409. 'recherche de la langue
  410. Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
  411. Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)
  412.  
  413. 'vérification de si langue langue existe
  414. 'checking if language exists
  415. If TrouveLangue Is Nothing Then
  416.     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.")
  417.     End
  418. Else
  419.     Range(TrouveLangue.Address).Select
  420. End If
  421.  
  422. 'Affectation des valeurs aux variables
  423. MillionsLangue = ActiveCell.Offset(1, 0).Value
  424. MillionsLangueLenght = Len(MillionsLangue)
  425. MilliardsLangue = ActiveCell.Offset(2, 0).Value
  426. MilliardsLangueLenght = Len(MilliardsLangue)
  427. PonctMLangue = ActiveCell.Offset(3, 0).Value
  428. PonctMdLangue = ActiveCell.Offset(4, 0).Value
  429. RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
  430. FlottesLangue = ActiveCell.Offset(6, 0).Value
  431. DefLangue = ActiveCell.Offset(7, 0).Value
  432. JoueurLangue = ActiveCell.Offset(8, 0).Value
  433. ActiviteLangue = ActiveCell.Offset(9, 0).Value
  434. RessourcesLangue = ActiveCell.Offset(10, 0).Value
  435.  
  436. 'Msgbox De vérification des variables :
  437. 'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)
  438.  
  439.  
  440. 'Affecation des valeurs aux variables :
  441. Valeur_Cherchee = RapportDespionnageLangue
  442. 'MsgBox Valeur_Cherchee
  443.  
  444. Range("W37").Value = 0
  445. Pourcentage = 0
  446. 'MsgBox Valeur_Cherchee
  447. 'Dans la plage :
  448. Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")
  449. NbLignes = Cells(Rows.Count, 1).End(xlUp).Row
  450.  
  451. 'Recherche de la ligne "Joueur"
  452. 'seach lines containing "Player"
  453. Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
  454. 'MsgBox Trouve
  455.  
  456. If Trouve Is Nothing Then
  457.     'Dans le cas où la donnée n'est pas trouvée
  458.    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
  459. Else
  460.     'Dans le cas où "Joueur" est trouvé, exctraction de la coordonnée se trouvant derrière
  461.    PremiereAdresseTrouvee = Trouve.Address
  462.     Do
  463.         AdresseTrouvee = Trouve.Address
  464.         Range(Trouve.Address).Select
  465.         ActiveCell.Offset(0, 1).Select
  466.         'Recherche de la "coordonnée" des caractères [ et ], afin de définir ensuite où couper la chaînes de caractère
  467.        EmplacementCoord = InStr(Trouve, "[")
  468.         EmplacementFinCoord = InStr(Trouve, "]")
  469.         'MsgBox (EmplacementCoord)
  470.        'MsgBox (EmplacementFinCoord)
  471.        
  472.         'Utilisation de EmplacementCoord et EmplacementFinCoord pour récupérer la zone où se trouve la coordonnée
  473.        'This line extracts the coord from the string
  474.        TempCoord = Mid(Trouve, EmplacementCoord + 1, EmplacementFinCoord - EmplacementCoord - 1)
  475.         'MsgBox (TempCoord)
  476.        ActiveCell.Offset(4, 0).Value = TempCoord
  477.             With ActiveCell.Offset(4, 0).Interior
  478.                 .Pattern = xlUp
  479.                 .PatternThemeColor = xlThemeColorAccent3
  480.                 .ThemeColor = xlThemeColorAccent3
  481.                 .TintAndShade = 0.599963377788629
  482.                 .PatternTintAndShade = 0.399945066682943
  483.             End With
  484.         Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
  485.  
  486.         'Calcul du pourcentage
  487.        Ligne = ActiveCell.Row
  488.         Range("W37").Value = Ligne / NbLignes * 100
  489.         Application.StatusBar = "Traitement des coordonnées  " + CStr([W37]) + "%"
  490.  
  491.  
  492.     Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
  493. End If
  494.  
  495. 'MsgBox AdresseTrouvee
  496. 'Vidage des variables
  497. Set PlageDeRecherche = Nothing
  498. Set Trouve = Nothing
  499. End Sub
  500.  
  501.  
  502.  
  503. Sub ChercheRessourcesNew()
  504.  
  505. 'Déclaration des variables de recherche
  506. Dim Trouve As Range, PlageDeRecherche As Range, Valeur_Cherchee As String, AdresseTrouvee As String, PremiereAdresseTrouvee As String
  507. 'Déclaration des variables d'extraction de coordonnées :
  508. Dim Ressources As String, LigneRessources As String, LigneRessourcesSplit() As String, Metal As String, Cristal As String, Deuterium As String
  509. 'Déclaration des variables de calcul de progression de traitement :
  510. Dim Pourcentage As Long, NbLignes As Long, Ligne As Long
  511. 'Déclaration des variables pour l'USM :
  512. Dim USMString As String, USMStringSplit() As String, USMMetal As String, USMCristal As String, USMDeut As String, RessourcesUSM As String, Ratio As String
  513. 'Déclaration des variables de langue
  514. Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
  515. Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
  516. 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
  517.  
  518. 'Zone de détection de langue
  519. Langue = Range("Z14").Value
  520. 'recherche de la langue
  521. Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
  522. Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)
  523.  
  524. 'vérification de si la langue existe
  525. If TrouveLangue Is Nothing Then
  526.     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.")
  527.     End
  528. Else
  529.     Range(TrouveLangue.Address).Select
  530. End If
  531.  
  532. 'Affectation des valeurs aux variables
  533. MillionsLangue = ActiveCell.Offset(1, 0).Value
  534. MillionsLangueLenght = Len(MillionsLangue)
  535. MilliardsLangue = ActiveCell.Offset(2, 0).Value
  536. MilliardsLangueLenght = Len(MilliardsLangue)
  537. PonctMLangue = ActiveCell.Offset(3, 0).Value
  538. PonctMdLangue = ActiveCell.Offset(4, 0).Value
  539. RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
  540. FlottesLangue = ActiveCell.Offset(6, 0).Value
  541. DefLangue = ActiveCell.Offset(7, 0).Value
  542. JoueurLangue = ActiveCell.Offset(8, 0).Value
  543. ActiviteLangue = ActiveCell.Offset(9, 0).Value
  544. RessourcesLangue = ActiveCell.Offset(10, 0).Value
  545. CristalLangue = ActiveCell.Offset(12, 0).Value
  546. DeuteriumLangue = ActiveCell.Offset(13, 0).Value
  547.  
  548. 'Msgbox De vérification des variables :
  549. 'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)
  550.  
  551.  
  552. 'Affectation des valeurs aux variables :
  553. Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")
  554. Valeur_Cherchee = RessourcesLangue
  555. Pourcentage = 0
  556. NbLignes = 0
  557. Ligne = 0
  558. NbLignes = Cells(Rows.Count, 1).End(xlUp).Row
  559. 'Mise à 0 du pourcentage :
  560. Application.StatusBar = "Traitement des coordonnées : 0%"
  561.  
  562. 'Récupération du taux USM
  563.  
  564. USMString = Range("W21").Value
  565. USMStringSplit = Split(USMString, "/")
  566. USMMetal = USMStringSplit(0)
  567. USMCristal = USMStringSplit(1)
  568. USMDeut = USMStringSplit(2)
  569. 'MsgBox ("Le taux USM est de : " & USMMetal & "/" & USMCristal & "/" & USMDeut)
  570.        
  571.  
  572. 'Recherche
  573. Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
  574.  
  575. If Trouve Is Nothing Then
  576.  
  577.     'Dans le cas où la donnée n'est pas trouvée
  578.    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
  579. Else
  580.     'Dans le cas où "Resources: " est trouvé, extraction de la coordonnée se trouvant derrière
  581.    PremiereAdresseTrouvee = Trouve.Address
  582.     Do
  583.         AdresseTrouvee = Trouve.Address
  584.         Range(Trouve.Address).Select
  585.         'LigneRessources va récupérer le contenu de la variable
  586.        
  587.         LigneRessources = ActiveCell.Value
  588.         LigneRessourcesSplit = Split(LigneRessources, ":")
  589.         'Séparation des 3 ressources + ressources dans 4 variables distinctes
  590.        Metal = LigneRessourcesSplit(1)
  591.         Cristal = LigneRessourcesSplit(2)
  592.         Deuterium = LigneRessourcesSplit(3)
  593.         Ressources = LigneRessourcesSplit(4)
  594.         'Nettoyage des mots restants dans les variables
  595.        Metal = Replace(Metal, CristalLangue, "")
  596.         Metal = Replace(Metal, " ", "")
  597.         If Right(Metal, MilliardsLangueLenght) = MilliardsLangue Then
  598.             Metal = Replace(Metal, MilliardsLangue, "")
  599.             Metal = Replace(Metal, PonctMdLangue, ",")
  600.             Metal = Metal * 1000000000
  601.             'MsgBox ("La valeur de métal est de : " & Metal)
  602.        End If
  603.         If Right(Metal, MillionsLangueLenght) = MillionsLangue Then
  604.             Metal = Replace(Metal, MillionsLangue, "")
  605.             Metal = Replace(Metal, PonctMdLangue, ",")
  606.             Metal = Metal * 1000000
  607.             'MsgBox ("La valeur de métal est de : " & Metal)
  608.        End If
  609.            
  610.         'Cristal
  611.        Cristal = Replace(Cristal, DeuteriumLangue, "")
  612.         Cristal = Replace(Cristal, " ", "")
  613.         If Right(Cristal, MilliardsLangueLenght) = MilliardsLangue Then
  614.             Cristal = Replace(Cristal, MilliardsLangue, "")
  615.             Cristal = Replace(Cristal, PonctMdLangue, ",")
  616.             Cristal = Cristal * 1000000000
  617.             'MsgBox ("La valeur de métal est de : " & Cristal)
  618.        End If
  619.         If Right(Cristal, MillionsLangueLenght) = MillionsLangue Then
  620.             Cristal = Replace(Cristal, MillionsLangue, "")
  621.             Cristal = Replace(Cristal, PonctMdLangue, ",")
  622.             Cristal = Cristal * 1000000
  623.             'MsgBox ("La valeur de métal est de : " & Cristal)
  624.        End If
  625.        
  626.         'Deutérium
  627.        Deuterium = Replace(Deuterium, Left(RessourcesLangue, Len(RessourcesLangue) - 1), "")
  628.         Deuterium = Replace(Deuterium, " ", "")
  629.         If Right(Deuterium, MilliardsLangueLenght) = MilliardsLangue Then
  630.             Deuterium = Replace(Deuterium, MilliardsLangue, "")
  631.             Deuterium = Replace(Deuterium, PonctMdLangue, ",")
  632.             Deuterium = Deuterium * 1000000000
  633.             'MsgBox ("La valeur de métal est de : " & Deuterium)
  634.        End If
  635.         If Right(Deuterium, MillionsLangueLenght) = MillionsLangue Then
  636.             Deuterium = Replace(Deuterium, MillionsLangue, "")
  637.             Deuterium = Replace(Deuterium, PonctMdLangue, ",")
  638.             Deuterium = Deuterium * 1000000
  639.             'MsgBox ("La valeur de métal est de : " & Deuterium)
  640.        End If
  641.        
  642.         'Ressources
  643.        Ressources = Replace(Ressources, Left(RessourcesLangue, Len(RessourcesLangue) - 1), "")
  644.         Ressources = Replace(Ressources, " ", "")
  645.         If Right(Ressources, MilliardsLangueLenght) = MilliardsLangue Then
  646.             Ressources = Replace(Ressources, MilliardsLangue, "")
  647.             Ressources = Replace(Ressources, PonctMdLangue, ",")
  648.             Ressources = Ressources * 1000000000
  649.             'MsgBox ("La valeur de métal est de : " & Ressources)
  650.        End If
  651.         If Right(Ressources, MillionsLangueLenght) = MillionsLangue Then
  652.             Ressources = Replace(Ressources, MillionsLangue, "")
  653.             Ressources = Replace(Ressources, PonctMdLangue, ",")
  654.             Ressources = Ressources * 1000000
  655.             'MsgBox ("La valeur de métal est de : " & Ressources)
  656.        End If
  657.         Metal = Replace(Metal, PonctMLangue, "")
  658.         Cristal = Replace(Cristal, PonctMLangue, "")
  659.         Deuterium = Replace(Deuterium, PonctMLangue, "")
  660.         Ressources = Replace(Ressources, PonctMLangue, "")
  661.        
  662.        
  663.         'MsgBox ("Métal:        " & Metal & vbNewLine & "Cristal:        " & Cristal & vbNewLine & "Deut :        " & Deuterium & vbNewLine & "Ressources :        " & Ressources)
  664.        
  665.        
  666.         'MsgBox LigneRessources
  667.        'Calcul de la valeur USM :
  668.        RessourcesUSM = (Metal * USMDeut) + (Cristal * USMCristal) + (Deuterium * USMMetal)
  669.         'Note : Le ratio doit avoir été récupéré avec la fonction ChercheLoot
  670.        Ratio = ActiveCell.Offset(-1, 7).Value
  671.         RessourcesUSM = RessourcesUSM * Ratio
  672.         RessourcesUSM = RessourcesUSM
  673.         'MsgBox ("La valeur USM des ressources est de " & RessourcesUSM & "la valeur de la renta est de " & Ressources / 2)
  674.  
  675.        
  676.         'Ecriture des données dans le tableau
  677.        'writing datas on board
  678.        ActiveCell.Offset(-1, 3) = Int(Ressources)
  679.         ActiveCell.Offset(-1, 4) = Int(Metal)
  680.         ActiveCell.Offset(-1, 5) = Int(Cristal)
  681.         ActiveCell.Offset(-1, 6) = Int(Deuterium)
  682.         ActiveCell.Offset(-1, 9) = Int(RessourcesUSM)
  683.        
  684.        
  685.         'Recherche de la prochaine correspondance "Resources:" :
  686.        'search next line with "resources" inside
  687.        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
  688.         Metal = 0
  689.         Cristal = 0
  690.         Deuterium = 0
  691.         Ressources = 0
  692.         '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)
  693.        Pourcentage = Pourcentage + 1
  694.  
  695.         Ligne = ActiveCell.Row
  696.         Range("W37").Value = Ligne / NbLignes * 100
  697.         Application.StatusBar = "Traitement des ressources  " + CStr([W37]) + "%"
  698.  
  699.  
  700.        
  701.     Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
  702. End If
  703.  
  704. End Sub
  705.  
  706.  
  707.  
  708. Sub ChercheLoot()
  709. 'Déclaration des variables de recherche :
  710. Dim Trouve As Range, PlageDeRecherche As Range, TrouveSplit() As String, Part As String, PartSplit() As String, Loot As String, Ratio As Single
  711. Dim Valeur_Cherchee As String, AdresseTrouvee As String
  712. 'Déclaration des variables de mise en forme :
  713. Dim Pourcentage As Long, NbLignes As Long, Ligne As Long
  714. 'Déclaration des variables de langue
  715. Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
  716. Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
  717. Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range, ButinLangue As String
  718.  
  719. 'Zone de détection de langue
  720. Langue = Range("Z14").Value
  721. 'recherche de la langue
  722. Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
  723. Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)
  724.  
  725. 'vérification de si la langue existe
  726. If TrouveLangue Is Nothing Then
  727.     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.")
  728.     End
  729. Else
  730.     Range(TrouveLangue.Address).Select
  731. End If
  732.  
  733. 'Affectation des valeurs aux variables
  734. MillionsLangue = ActiveCell.Offset(1, 0).Value
  735. MillionsLangueLenght = Len(MillionsLangue)
  736. MilliardsLangue = ActiveCell.Offset(2, 0).Value
  737. MilliardsLangueLenght = Len(MilliardsLangue)
  738. PonctMLangue = ActiveCell.Offset(3, 0).Value
  739. PonctMdLangue = ActiveCell.Offset(4, 0).Value
  740. RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
  741. FlottesLangue = ActiveCell.Offset(6, 0).Value
  742. DefLangue = ActiveCell.Offset(7, 0).Value
  743. JoueurLangue = ActiveCell.Offset(8, 0).Value
  744. ActiviteLangue = ActiveCell.Offset(9, 0).Value
  745. RessourcesLangue = ActiveCell.Offset(10, 0).Value
  746. ButinLangue = ActiveCell.Offset(11, 0).Value
  747.  
  748. 'Msgbox De vérification des variables :
  749. 'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)
  750.  
  751.  
  752. 'Affectation des valeurs aux variables
  753. Valeur_Cherchee = ButinLangue
  754. Range("W37").Value = 0
  755. Pourcentage = 0
  756. 'Dans la plage :
  757. Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")
  758. NbLignes = Cells(Rows.Count, 1).End(xlUp).Row
  759.  
  760. 'Utilisation de la méthode Find
  761. Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
  762. 'MsgBox Trouve
  763. If Trouve Is Nothing Then
  764.     'Dans le cas où la donnée n'est pas trouvée
  765.    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
  766. Else
  767.     'Dans le cas où "Player" est trouvé, exctraction de la coordonnée se trouvant derrière
  768.    PremiereAdresseTrouvee = Trouve.Address
  769.     Do
  770.         AdresseTrouvee = Trouve.Address
  771.         Range(Trouve.Address).Select
  772.         ActiveCell.Offset(-2, 7).Select
  773.         'Découpage de la chaine de caractère en cherchant d'abord ":" puis "%" afin de localiser le chiffre
  774.        TrouveSplit = Split(Trouve, ":")
  775.         Part = TrouveSplit(1)
  776.         'MsgBox (Part)
  777.        PartSplit = Split(Part, "%")
  778.         Loot = PartSplit(0)
  779.         Loot = Replace(Loot, " ", "")
  780.        
  781.         'Passage du % de butin en ratio
  782.        Ratio = Loot / 100
  783.         ActiveCell.Value = Ratio
  784.         'MsgBox (Ratio)
  785.        
  786.         'Recherche de la ligne suivante
  787.        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
  788.         'Calcul du pourcentage d'avancement
  789.        
  790.         Ligne = ActiveCell.Row
  791.         Range("W37").Value = Ligne / NbLignes * 100
  792.         Application.StatusBar = "Traitement des ratios  " + CStr([W37]) + "%"
  793.     Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
  794. End If
  795.  
  796. 'MsgBox AdresseTrouvee
  797. Set PlageDeRecherche = Nothing
  798. Set Trouve = Nothing
  799. End Sub
  800.        
  801. Sub ChercheDefsFeets()
  802.  
  803. 'Déclaration des variables de recherche :
  804. 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
  805. Dim Valeur_Cherchee As String, AdresseTrouvee As String
  806. 'Variables de gestion de ligne
  807. Dim Ligne As Integer
  808. 'Déclaration des variables de langue
  809. Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
  810. Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
  811. Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range
  812.  
  813. 'Zone de détection de langue
  814. Langue = Range("Z14").Value
  815. 'recherche de la langue
  816. Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
  817. Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)
  818.  
  819. 'vérification de si la langue existe
  820. If TrouveLangue Is Nothing Then
  821.     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.")
  822.     End
  823. Else
  824.     Range(TrouveLangue.Address).Select
  825. End If
  826.  
  827. 'Affectation des valeurs aux variables
  828. MillionsLangue = ActiveCell.Offset(1, 0).Value
  829. MillionsLangueLenght = Len(MillionsLangue)
  830. MilliardsLangue = ActiveCell.Offset(2, 0).Value
  831. MilliardsLangueLenght = Len(MilliardsLangue)
  832. PonctMLangue = ActiveCell.Offset(3, 0).Value
  833. PonctMdLangue = ActiveCell.Offset(4, 0).Value
  834. RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
  835. FlottesLangue = ActiveCell.Offset(6, 0).Value
  836. DefLangue = ActiveCell.Offset(7, 0).Value
  837. JoueurLangue = ActiveCell.Offset(8, 0).Value
  838. ActiviteLangue = ActiveCell.Offset(9, 0).Value
  839. RessourcesLangue = ActiveCell.Offset(10, 0).Value
  840.  
  841. 'Msgbox De vérification des variables :
  842. 'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)
  843.  
  844.  
  845. 'Affectation des valeurs aux variables
  846. Valeur_Cherchee = FlottesLangue
  847. Range("W37").Value = 0
  848. Pourcentage = 0
  849. I = 0
  850. 'Dans la plage :
  851. Set PlageDeRecherche = ActiveSheet.Range("A1:A50000")
  852. NbLignes = Cells(Rows.Count, 1).End(xlUp).Row
  853.  
  854. 'Utilisation de la méthode Find
  855. Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
  856. 'MsgBox Trouve
  857.  
  858.  
  859. If Trouve Is Nothing Then
  860.     'Dans le cas où la donnée n'est pas trouvée
  861.    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
  862. Else
  863.     'Dans le cas où "Player" est trouvé, exctraction de la coordonnée se trouvant derrière
  864.    PremiereAdresseTrouvee = Trouve.Address
  865.     Do
  866.         'MsgBox (Trouve)
  867.        AdresseTrouvee = Trouve.Address
  868.         Range(Trouve.Address).Select
  869.  
  870.         Flotte = ""
  871.         Def = ""
  872.         TrouveSplit = Split(Trouve, ":")
  873.         Flotte = TrouveSplit(1)
  874.         'Vérification de si la ligne contient bien des défenses afin d'éviter des erreurs
  875.        If Trouve Like "*" & DefLangue & "*" Then
  876.             Def = TrouveSplit(2)
  877.         End If
  878.         'MsgBox ("Flotte :" & Flotte & " | Défense :" & Def)
  879.        
  880.         FlotteSplit = Split(Flotte, DefLangue)
  881.         FlotteFinal = FlotteSplit(0)
  882.        
  883.         FlotteFinal = Replace(FlotteFinal, " ", "")
  884.         Def = Replace(Def, " ", "")
  885.         'MsgBox ("Flotte :" & FlotteFinal & " | Défense :" & Def)
  886.  
  887.        
  888.         'Mise en forme des millions et milliards
  889.        If Right(FlotteFinal, MilliardsLangueLenght) = MilliardsLangue Then
  890.             FlotteFinal = Replace(FlotteFinal, MilliardsLangue, "")
  891.             FlotteFinal = Replace(FlotteFinal, PonctMdLangue, ",")
  892.             FlotteFinal = FlotteFinal * 1000000000
  893.         End If
  894.         If Right(FlotteFinal, MillionsLangueLenght) = MillionsLangue Then
  895.             FlotteFinal = Replace(FlotteFinal, MillionsLangue, "")
  896.             FlotteFinal = Replace(FlotteFinal, PonctMdLangue, ",")
  897.             FlotteFinal = FlotteFinal * 1000000
  898.         End If
  899.         If Right(Def, MilliardsLangueLenght) = MilliardsLangue Then
  900.             Def = Replace(Def, MilliardsLangue, "")
  901.             Def = Replace(Def, PonctMdLangue, ",")
  902.             Def = Def * 1000000000
  903.         End If
  904.         If Right(Def, MillionsLangueLenght) = MillionsLangue Then
  905.             Def = Replace(Def, MillionsLangue, "")
  906.             Def = Replace(Def, PonctMdLangue, ",")
  907.             Def = Def * 1000000
  908.         End If
  909.         FlotteFinal = Replace(FlotteFinal, PonctMLangue, "")
  910.         Def = Replace(Def, PonctMLangue, "")
  911.         If Def <> "" Then
  912.             Def = Def / 1000
  913.         End If
  914.        
  915.  
  916.  
  917.        
  918.         FlotteFinal = FlotteFinal / 1000
  919.        
  920.         'MsgBox ("La flotte est de :" & FlotteFinal & vbNewLine & "La def est de :" & Def)
  921.  
  922.        
  923.         ActiveCell.Offset(-3, 11).Select
  924.         ActiveCell.Value = FlotteFinal
  925.         ActiveCell.Offset(0, 1).Value = Def
  926.        
  927.         FlotteSingle = FlotteFinal
  928.         If Def <> "" Then
  929.             DefSingle = Def
  930.         End If
  931.        
  932.        
  933.        
  934.        
  935.         '---------------------------------------------------------------------------------------------------------
  936.        'Elimination des defs et flottes ayant un montant supérieur à ce que souhaite le joueur
  937.        'Msgbox d'analyse des données :
  938.  
  939.         'Flottes :
  940.            
  941.            
  942.         If FlotteSingle > Range("Z6").Value Then
  943.             Ligne = ActiveCell.Row
  944.             'MsgBox ("Valeur de la flotte supérieure à celle demandée")
  945.            Range("B" & Ligne & ":Q" & Ligne).Select
  946.             Range("B" & Ligne & ":Q" & Ligne).ClearContents
  947.             With Selection.Interior
  948.                 .Pattern = xlNone
  949.                 .TintAndShade = 0
  950.                 .PatternTintAndShade = 0
  951.             End With
  952.             With Selection.Font
  953.                 .ThemeColor = xlThemeColorLight1
  954.                 .TintAndShade = 0
  955.             End With
  956.         End If
  957.         Ligne = Empty
  958.        
  959.         'Défenses :
  960.        If DefSingle > Range("Z7").Value Then
  961.             Ligne = ActiveCell.Row
  962.             'MsgBox ("Valeur de la def supérieure à celle demandée")
  963.            Range("B" & Ligne & ":Q" & Ligne).Select
  964.             Range("B" & Ligne & ":Q" & Ligne).ClearContents
  965.             With Selection.Interior
  966.                 .Pattern = xlNone
  967.                 .TintAndShade = 0
  968.                 .PatternTintAndShade = 0
  969.             End With
  970.             With Selection.Font
  971.                 .ThemeColor = xlThemeColorLight1
  972.                 .TintAndShade = 0
  973.             End With
  974.         End If
  975.        
  976.  
  977.        
  978.         '---------------------------------------------------------------------------------------------------------
  979.                                                                    'Recherche de la ligne suivante
  980.        Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
  981.         Pourcentage = Pourcentage + 1
  982.         Ligne = ActiveCell.Row
  983.         Range("W37").Value = Ligne / NbLignes * 100
  984.         Application.StatusBar = "Traitement des flottes et défenses  " + CStr([W37]) + "%"
  985.         Pourcentage = 0
  986.     Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
  987. End If
  988.  
  989. 'MsgBox AdresseTrouvee
  990. Set PlageDeRecherche = Nothing
  991. Set Trouve = Nothing
  992.  
  993.  
  994. End Sub
  995.  
  996.  
  997. Sub ExtractCoordCreationURL()
  998.  
  999. 'Déclaration des variables de recherche :
  1000. Dim Trouve As Range, PlageDeRecherche As Range
  1001. Dim Valeur_Cherchee As String, AdresseTrouvee As String
  1002. 'Déclaration des variables de mise en forme :
  1003. Dim EmplacementG As String, EmplacementSS As String, TempSS As String, EndSS As Integer, EmplacementPos As String, TempPos As Integer, TempG As String
  1004. 'Variable URL
  1005. Dim URLPT As String, URLGT As String
  1006. 'Numéro de ligne
  1007. Dim Compteur As Integer
  1008. 'Variables utilisateur
  1009. Dim http As String, Univers As String
  1010. 'Déclaration des variables de langue
  1011. Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
  1012. Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
  1013. Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range
  1014.  
  1015. 'Zone de détection de langue
  1016. Langue = Range("Z14").Value
  1017. 'recherche de la langue
  1018. Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
  1019. Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)
  1020.  
  1021. 'vérification de si la langue existe
  1022. If TrouveLangue Is Nothing Then
  1023.     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.")
  1024.     End
  1025. Else
  1026.     Range(TrouveLangue.Address).Select
  1027. End If
  1028.  
  1029. 'Affectation des valeurs aux variables
  1030. MillionsLangue = ActiveCell.Offset(1, 0).Value
  1031. MillionsLangueLenght = Len(MillionsLangue)
  1032. MilliardsLangue = ActiveCell.Offset(2, 0).Value
  1033. MilliardsLangueLenght = Len(MilliardsLangue)
  1034. PonctMLangue = ActiveCell.Offset(3, 0).Value
  1035. PonctMdLangue = ActiveCell.Offset(4, 0).Value
  1036. RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
  1037. FlottesLangue = ActiveCell.Offset(6, 0).Value
  1038. DefLangue = ActiveCell.Offset(7, 0).Value
  1039. JoueurLangue = ActiveCell.Offset(8, 0).Value
  1040. ActiviteLangue = ActiveCell.Offset(9, 0).Value
  1041. RessourcesLangue = ActiveCell.Offset(10, 0).Value
  1042.  
  1043. 'Msgbox De vérification des variables :
  1044. 'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)
  1045.  
  1046.  
  1047.  
  1048. Compteur = 0
  1049.  
  1050. 'Affectation des valeurs aux variables
  1051. Valeur_Cherchee = ":"
  1052. 'Dans la plage :
  1053. Set PlageDeRecherche = ActiveSheet.Range("B2:B5000")
  1054.  
  1055. 'Utilisation de la méthode Find
  1056. Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
  1057. 'MsgBox Trouve
  1058.  
  1059. If Trouve Is Nothing Then
  1060.     'Dans le cas où la donnée n'est pas trouvée
  1061.    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
  1062. Else
  1063.     'Dans le cas où "Player" est trouvé, exctraction de la coordonnée se trouvant derrière
  1064.    PremiereAdresseTrouvee = Trouve.Address
  1065.     Do
  1066.         AdresseTrouvee = Trouve.Address
  1067.         Range(Trouve.Address).Select
  1068.         'Galaxie
  1069.        EmplacementG = InStr(Trouve, ":")
  1070.         TempG = Left(Trouve, EmplacementG - 1)
  1071.         EmplacementG = TempG
  1072.         'Système Solaire
  1073.        EmplacementSS = InStr(Trouve, ":")
  1074.         TempSS = Mid(Trouve, EmplacementSS + 1)
  1075.         EmplacementPos = TempSS
  1076.         EmplacementSS = InStr(TempSS, ":")
  1077.         TempSS = Mid(TempSS, 1, EmplacementSS - 1)
  1078.         'Position planète
  1079.        TempPos = InStr(EmplacementPos, ":")
  1080.         EmplacementPos = Mid(EmplacementPos, TempPos + 1)
  1081.         'Le MSGBOX suivant permet d'afficher les coords
  1082.        'MsgBox (EmplacementG & "." & TempSS & "." & EmplacementPos)
  1083.        
  1084.         'Coords stockées dans :
  1085.        'EmplacementG = Galaxie
  1086.        'TempSS = SS
  1087.        'EmplacementPos = Position
  1088.        
  1089.         'Récupération de l'univers et de l'http :
  1090.        http = Range("Z2").Value
  1091.         Univers = Range("Z3").Value
  1092.        
  1093.         'Creation URL
  1094.        'Exemple d'URL :
  1095.        '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
  1096.        Compteur = Compteur + 1
  1097.         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)
  1098.         'ActiveCell.Offset(0, 9).Value = URLPT
  1099.        'Application.ActiveSheet.Hyperlinks.Add(Anchor:="ActiveCell.Offset(0, 9).Address", Address:="URLPT", SubAddress:="", ScreenTip:="Critical", TextToDisplay:="ici")
  1100.        ActiveCell.Offset(0, 14).Hyperlinks.Add ActiveCell.Offset(0, 14), URLPT, "", "", URLPT
  1101.    
  1102.         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)
  1103.         ActiveCell.Offset(0, 15).Hyperlinks.Add ActiveCell.Offset(0, 15), URLGT, "", "", URLGT
  1104.        
  1105.        
  1106.         Set Trouve = PlageDeRecherche.Cells.FindNext(Trouve)
  1107.     Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresseTrouvee
  1108. End If
  1109.  
  1110. 'MsgBox AdresseTrouvee
  1111. Set PlageDeRecherche = Nothing
  1112. Set Trouve = Nothing
  1113.  
  1114.  
  1115.  
  1116. End Sub
  1117.  
  1118.  
  1119. Sub Statistiques()
  1120.  
  1121. 'Nettoyage de la zone
  1122. Range("W3:W10").Select
  1123. Selection.ClearContents
  1124.  
  1125. Range("W3").Value = 0
  1126. Range("W7").Value = 0
  1127. Range("W9").Value = 0
  1128.  
  1129. 'Somme de la renta de chaque vague
  1130. Range("W3").Value = WorksheetFunction.Sum(Range("I2:I" & Range("Z4").Value + 1))
  1131. Range("W7").Value = WorksheetFunction.Sum(Range("I" & Range("Z4").Value + 2 & ":I" & Range("Z4").Value * 2 + 1))
  1132. Range("W9").Value = WorksheetFunction.Sum(Range("I" & Range("Z4").Value * 2 + 2 & ":I" & Range("Z4").Value * 3 + 1))
  1133. 'Somme des PT de la première vague
  1134. Range("W4").Value = WorksheetFunction.Sum(Range("N2:N" & Range("Z4").Value + 1))
  1135. 'Moyenne par ina de chaque vague
  1136. If Range("W3").Value > 0 Then
  1137.     Range("W5").Value = WorksheetFunction.Average(Range("I2:I" & Range("Z4").Value + 1))
  1138. End If
  1139. If Range("W7").Value > 0 Then
  1140. Range("W8").Value = WorksheetFunction.Average(Range("I" & Range("Z4").Value + 2 & ":I" & Range("Z4").Value * 2 + 1))
  1141. End If
  1142. If Range("W9").Value > 0 Then
  1143. Range("W10").Value = WorksheetFunction.Average(Range("I" & Range("Z4").Value * 2 + 2 & ":I" & Range("Z4").Value * 3 + 1))
  1144. End If
  1145.  
  1146. End Sub
  1147.  
  1148. Sub RentaHeure()
  1149.  
  1150. 'Variables de récupération des données des coords joueur
  1151. Dim PlayerCoord As String, PlayerCoordSplit() As String, Galaxie As Integer, Systeme As Integer, Position As Integer
  1152. 'Variables des variables pour la vitesse des vaisseaux
  1153. Dim VitesseUni As Long, Techs As String, TechsSplit() As String, TypeVaisseau As String, Combustion As Integer, Impulsion As Integer, Propulsion As Integer
  1154. 'Variables de calcul de la vitesse des vaisseaux
  1155. Dim VitesseVaisseau As Long
  1156. 'Variables Diverses
  1157. Dim ErrorCode As Integer, NbCells As Integer, NbGalaxies As String, NbSS As String, UniCirculaire As String, TechnoPT As String
  1158. 'Variables de récupération des coords de destination
  1159. Dim DestCoord As String, DestCoordSplit() As String, DestGalaxie As Integer, DestSysteme As Integer, DestPosition As Integer
  1160. 'Variables de calcul de distance de trajet
  1161. Dim GalaxiesTraversees As Integer, SystemesTraverses As Integer, PositionsTraversees As Integer, GalaxiesFinal As Long, SystemesFinal As Long, PositionsFinales As Long
  1162. 'Variables de calcul du temps de trajet
  1163. Dim TempsG As Double, TempsSS As Double, TempsPos As Double
  1164. 'Variables de calcul de la renta heure
  1165. Dim RentaHeureUSM As Single, RentaHeureBrute As Single, ChoixTypeRenta As String
  1166. 'Déclaration des variables de langue
  1167. Dim Langue As String, MillionsLangue As String, MillionsLangueLenght As Integer, MilliardsLangue As String, MilliardsLangueLenght As Integer
  1168. Dim PonctMLangue As String, PonctMdLangue As String, RapportDespionnageLangue As String, FlottesLangue As String
  1169. Dim DefLangue As String, JoueurLangue As String, ActiviteLangue As String, RessourcesLangue As String, PlageDeRechercheLangue As Range, TrouveLangue As Range
  1170.  
  1171. 'Zone de détection de langue
  1172. Langue = Range("Z14").Value
  1173. 'recherche de la langue
  1174. Set PlageDeRechercheLangue = ActiveSheet.Range("AB1:AZ1")
  1175. Set TrouveLangue = PlageDeRechercheLangue.Cells.Find(what:=Langue, LookAt:=xlWhole)
  1176.  
  1177. 'vérification de si la langue existe
  1178. If TrouveLangue Is Nothing Then
  1179.     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.")
  1180.     End
  1181. Else
  1182.     Range(TrouveLangue.Address).Select
  1183. End If
  1184.  
  1185. 'Affectation des valeurs aux variables
  1186. MillionsLangue = ActiveCell.Offset(1, 0).Value
  1187. MillionsLangueLenght = Len(MillionsLangue)
  1188. MilliardsLangue = ActiveCell.Offset(2, 0).Value
  1189. MilliardsLangueLenght = Len(MilliardsLangue)
  1190. PonctMLangue = ActiveCell.Offset(3, 0).Value
  1191. PonctMdLangue = ActiveCell.Offset(4, 0).Value
  1192. RapportDespionnageLangue = ActiveCell.Offset(5, 0).Value
  1193. FlottesLangue = ActiveCell.Offset(6, 0).Value
  1194. DefLangue = ActiveCell.Offset(7, 0).Value
  1195. JoueurLangue = ActiveCell.Offset(8, 0).Value
  1196. ActiviteLangue = ActiveCell.Offset(9, 0).Value
  1197. RessourcesLangue = ActiveCell.Offset(10, 0).Value
  1198.  
  1199. 'Msgbox De vérification des variables :
  1200. 'MsgBox (MillionsLangue & MillionsLangueLenght & MilliardsLangue & MilliardsLangueLenght & PonctMLangue & PonctMdLangue & RapportDespionnageLangue & FlottesLangue & DefLangue & JoueurLangue & ActiviteLangue & RessourcesLangue)
  1201.  
  1202.  
  1203. ErrorCode = 0
  1204. 'Récupération des coordonnées du joueur
  1205. PlayerCoord = Range("W17").Value
  1206. NbGalaxies = Range("Z9").Value
  1207. NbSS = Range("Z10").Value
  1208. UniCirculaire = Range("Z11").Value
  1209. ChoixTypeRenta = Range("W20").Value
  1210. 'Séparation de la galaxie, SS et position
  1211. PlayerCoordSplit = Split(PlayerCoord, ":")
  1212. 'MsgBox ("Galaxie : " & PlayerCoordSplit(0) & ", Système solaire : " & PlayerCoordSplit(1) & " et Position : " & PlayerCoordSplit(2))
  1213. Galaxie = PlayerCoordSplit(0)
  1214. Systeme = PlayerCoordSplit(1)
  1215. Position = PlayerCoordSplit(2)
  1216.  
  1217. '-----------
  1218. 'Récupération des paramètres des vaisseaux (techs et type de vaisseau)
  1219. VitesseUni = Range("Z8").Value
  1220. Techs = Range("W18").Value
  1221. TypeVaisseau = Range("W19").Value
  1222. 'Séparation des 3 technologies des vaisseaux
  1223. TechsSplit = Split(Techs, ",")
  1224. 'MsgBox ("Technologie Combusion : " & TechsSplit(0) & ", Technologie Impulsion : " & TechsSplit(1) & ", Propulsion : " & TechsSplit(2))
  1225. Combustion = TechsSplit(0)
  1226. Impulsion = TechsSplit(1)
  1227. Propulsion = TechsSplit(2)
  1228.  
  1229. 'Récupération de la vitesse du vaisseau en fonction du type de vaisseau entré
  1230. Select Case TypeVaisseau
  1231.     Case "PT"
  1232.         'MsgBox ("Le type de vaisseau sélectionné est PT")
  1233.        VitesseVaisseau = 10000
  1234.         If Impulsion >= 5 Then
  1235.             VitesseVaisseau = VitesseVaisseau + (VitesseVaisseau * Impulsion * 0.2)
  1236.             'MsgBox ("Vitesse via impu : " & VitesseVaisseau)
  1237.            TechnoPT = "impu"
  1238.         Else
  1239.             VitesseVaisseau = VitesseVaisseau + (VitesseVaisseau * Combustion * 0.1)
  1240.             'MsgBox ("Vitesse via combu : " & VitesseVaisseau)
  1241.            TechnoPT = "combu"
  1242.         End If
  1243.     Case "GT"
  1244.         'MsgBox ("Le type de vaisseau sélectionné est GT")
  1245.        VitesseVaisseau = 7500
  1246.         VitesseVaisseau = VitesseVaisseau + (VitesseVaisseau * Combustion * 0.1)
  1247.         'MsgBox ("Vitesse via combu : " & VitesseVaisseau)
  1248.    Case "RIP"
  1249.         'MsgBox ("Le type de vaisseau sélectionné est RIP")
  1250.        VitesseVaisseau = 100
  1251.         VitesseVaisseau = VitesseVaisseau + (VitesseVaisseau * Propulsion * 0.3)
  1252.         'MsgBox ("Vitesse via prop : " & VitesseVaisseau)
  1253.    Case Else
  1254.         MsgBox ("Le type de vaisseau indiqué est incorrect. Merci de choisir entre PT, GT ou RIP")
  1255.         ErrorCode = 1
  1256. End Select
  1257.  
  1258. NbCells = Application.WorksheetFunction.CountA(Range("B2:B5000")) + 1
  1259.  
  1260. 'Récupération des coordonnées de destination via la boucle FOR
  1261. For Each CurCell In Range("B2:B" & NbCells)
  1262.     TempsG = 0
  1263.     TempsSS = 0
  1264.     TempsPos = 0
  1265.     RentaHeureBrute = 0
  1266.     RentaHeureUSM = 0
  1267.     DestCoord = CurCell.Value
  1268.     DestCoordSplit = Split(DestCoord, ":")
  1269.     DestGalaxie = DestCoordSplit(0)
  1270.     DestSysteme = DestCoordSplit(1)
  1271.     DestPosition = DestCoordSplit(2)
  1272.     'Les coordonnées sont récupérées et séparées en galaxies, SS et Pos
  1273.    'MsgBox ("G : " & DestGalaxie & ", SS : " & DestSysteme & ", Pos : " & DestPosition)
  1274.    '------------------------------------------------------------------------------------'
  1275.    
  1276.    
  1277.     'Calcul de la différence à parcourir
  1278.    GalaxiesTraversees = 0
  1279.     SystemesTraverses = 0
  1280.     PositionsTraversees = 0
  1281.     GalaxiesTraversees = Galaxie - DestGalaxie
  1282.     SystemesTraverses = Systeme - DestSysteme
  1283.     PositionsTraversees = Position - DestPosition
  1284.     'Note : à ce stade, il est normal que les valeurs soient erronnées.
  1285.    'Elimination des valeurs négatives
  1286.    If GalaxiesTraversees < 0 Then
  1287.         GalaxiesTraversees = GalaxiesTraversees * -1
  1288.     End If
  1289.     If SystemesTraverses < 0 Then
  1290.         SystemesTraverses = SystemesTraverses * -1
  1291.     End If
  1292.     If PositionsTraversees < 0 Then
  1293.         PositionsTraversees = PositionsTraversees * -1
  1294.     End If
  1295.     '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)
  1296.    '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
  1297.    If GalaxiesTraversees <> 0 Then
  1298.         Select Case UniCirculaire
  1299.             Case "Oui"
  1300.                 '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)
  1301.                If GalaxiesTraversees > NbGalaxies / 2 Then
  1302.                     'MsgBox ("Le nombre de galaxies à traverser est supérieur à la moitié de l'uni")
  1303.                    'Reset de galaxiestraversees, qui sera utilisée dans la suite
  1304.                    GalaxiesTraversees = 0
  1305.                     'Vérification de si la galaxie initiale est plus haute que la galaxie de destination
  1306.                    If Galaxie > DestGalaxie Then
  1307.                         GalaxiesTraversees = NbGalaxies + DestGalaxie
  1308.                         GalaxiesFinal = GalaxiesTraversees - Galaxie
  1309.                         'MsgBox ("Le nombre de galaxies à traverser est supérieur à la moitié de l'uni | Solution 1  " & GalaxiesFinal & " | Galaxie de destination : " & DestGalaxie)
  1310.                    ElseIf Galaxie < DestGalaxie Then
  1311.                         GalaxiesTraversees = NbGalaxies - DestGalaxie
  1312.                         GalaxiesFinal = GalaxiesTraversees + Galaxie
  1313.                         'MsgBox ("Le nombre de galaxies à traverser est supérieur à la moitié de l'uni | Solution 2  " & GalaxiesFinal & " | Galaxie de destination : " & DestGalaxie)
  1314.                    End If
  1315.                 Else
  1316.                     GalaxiesFinal = GalaxiesTraversees
  1317.                     '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)
  1318.                End If
  1319.             Case "Non"
  1320.                 If Galaxie > DestGalaxie Then
  1321.                     GalaxiesTraversees = 0
  1322.                     GalaxiesTraversees = Galaxie - DestGalaxie
  1323.                     GalaxiesFinal = GalaxiesTraversees
  1324.                     'MsgBox ("Solution 1  " & GalaxiesFinal & " | Galaxie de destination : " & DestGalaxie)
  1325.                ElseIf Galaxie < DestGalaxie Then
  1326.                     GalaxiesTraversees = DestGalaxie - Galaxie
  1327.                     GalaxiesFinal = GalaxiesTraversees
  1328.                     'MsgBox ("Solution 2  " & GalaxiesFinal & " | Galaxie de destination : " & DestGalaxie)
  1329.                End If
  1330.             Case Else
  1331.                 MsgBox ("Merci d'entrer une valeur correcte (Oui ou Non) pour la case S11")
  1332.         End Select
  1333.         'Calcul du temps de trajet interG ICI :
  1334.        '---
  1335.        TempsG = (10 + (35000 / 100 * Sqr((GalaxiesFinal * 20000) * 1000 / VitesseVaisseau))) / VitesseUni
  1336.         'Il faut compter le retour
  1337.        TempsG = TempsG * 2
  1338.         'MsgBox ("Le temps de trajet pour ce voyage de " & GalaxiesFinal & "galaxies en secondes est de : " & TempsG)
  1339.        'Il faut convertir en heures
  1340.        TempsG = TempsG / 3600
  1341.         'MsgBox TempsG
  1342.        'Calcul des renta heure
  1343.        'Cherche la Renta avec curcell.offset
  1344.        RentaHeureBrute = CurCell.Offset(0, 7).Value / TempsG
  1345.         'MsgBox RentaHeureBrute
  1346.        RentaHeureUSM = CurCell.Offset(0, 8).Value / TempsG
  1347.         '---
  1348.    'Ici se termine le cas dans lequel le voyage dure plus de une galaxie
  1349.    Else
  1350.         'Gestion des systèmes solaires
  1351.        If SystemesTraverses <> 0 Then
  1352.             Select Case UniCirculaire
  1353.                 Case "Oui"
  1354.                     '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)
  1355.                    If SystemesTraverses > NbSS / 2 Then
  1356.                         'MsgBox ("Le nombre de SS à traverser est supérieur à la moitié du SS")
  1357.                        'Reset de systemestraverses, qui sera utilisée par la suite
  1358.                        SystemesTraverses = 0
  1359.                         'Vérification de si le système de départ est plus haut ou plus bas que le ss de destination
  1360.                        If Systeme > DestSysteme Then
  1361.                             SystemesTraverses = NbSS + DestSysteme
  1362.                             SystemesFinal = SystemesTraverses - Systeme
  1363.                             'MsgBox ("Le nombre de SS à traverser est supérieur à la moitié de la galaxie | Solution 1  " & SystemesFinal & " | Systeme de destination : " & DestSysteme)
  1364.                        ElseIf Systeme < DestSysteme Then
  1365.                             SystemesTraverses = NbSS - DestSysteme
  1366.                             SystemesFinal = SystemesTraverses + Systeme
  1367.                             'MsgBox ("Le nombre de SS à traverser est supérieur à la moitié de la galaxie | Solution 2  " & SystemesFinal & " | Systeme de destination : " & DestSysteme)
  1368.                        End If
  1369.                     Else
  1370.                         SystemesFinal = SystemesTraverses
  1371.                         '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)
  1372.                    End If
  1373.                 Case "Non"
  1374.                     If Systeme > DestSysteme Then
  1375.                         SystemesTraverses = 0
  1376.                         SystemesTraverses = Systeme - DestSysteme
  1377.                         SystemesFinal = SystemesTraverses
  1378.                         'MsgBox ("Solution 1  " & SystemesFinal & " | Systeme de destination : " & DestSysteme)
  1379.                    ElseIf Systeme < DestSysteme Then
  1380.                         SystemesTraverses = DestSysteme - Systeme
  1381.                         SystemesFinal = SystemesTraverses
  1382.                         'MsgBox ("Solution 2  " & SystemesFinal & " | Système de destination : " & DestSysteme)
  1383.                    End If
  1384.                        
  1385.                 Case Else
  1386.                     MsgBox ("Merci d'entrer une valeur correcte (Oui ou Non) pour la case S11")
  1387.             End Select
  1388.             'Calcul du temps de trajet interSS ICI :
  1389.            '---
  1390.            TempsSS = (10 + 35000 / 100 * Sqr((2700 + 95 * SystemesFinal) * 1000 / VitesseVaisseau)) / VitesseUni
  1391.             'MsgBox ("Le temps de trajet pour ce voyage de " & SystemesFinal & "SS en secondes est de : " & TempsSS)
  1392.            'Il faut compter le retour
  1393.            TempsSS = TempsSS * 2
  1394.             'Il faut convertir en heures
  1395.            TempsSS = TempsSS / 3600
  1396.             'Calcul des renta heure
  1397.            'Cherche la Renta avec curcell.offset
  1398.            RentaHeureBrute = CurCell.Offset(0, 7).Value / TempsSS
  1399.             'MsgBox RentaHeureBrute
  1400.            RentaHeureUSM = CurCell.Offset(0, 8).Value / TempsSS
  1401.             '---
  1402.            'fin de gestion des systèmes solaires
  1403.        Else
  1404.             'calcul du nombre de positions à traverser
  1405.            'note : les ss ne sont pas circulaires
  1406.            If PositionsTraversees <> 0 Then
  1407.                 If Position > DestPosition Then
  1408.                     PositionsTraversees = 0
  1409.                     PositionsTraversees = Position - DestPosition
  1410.                     PositionsFinales = PositionsTraversees
  1411.                     'MsgBox ("Le nombre de positions traversées - solution 1 - est de : " & PositionsFinales)
  1412.                ElseIf Position < DestPosition Then
  1413.                     PositionsTraversees = DestPosition - Position
  1414.                     PositionsFinales = PositionsTraversees
  1415.                     'MsgBox ("Le nombre de positions traversées - solution 2 - est de : " & PositionsFinales)
  1416.                End If
  1417.                 'Calcul du temps de trajet pour un trajet dans le même SS :
  1418.                TempsPos = (10 + ((35000 / 100) * Sqr((1000 + 5 * PositionsFinales) * 1000 / VitesseVaisseau))) / VitesseUni
  1419.                 'MsgBox ("Le temps de trajet pour ce voyage de " & PositionsFinales & "positions en secondes est de : " & TempsPos)
  1420.                'Il faut compter le retour
  1421.                TempsPos = TempsPos * 2
  1422.                 'Il faut convertir en heures
  1423.                TempsPos = TempsPos / 3600
  1424.                 'Calcul des renta heure
  1425.                'Cherche la Renta avec curcell.offset
  1426.                RentaHeureBrute = CurCell.Offset(0, 7).Value / TempsPos
  1427.                 'MsgBox RentaHeureBrute
  1428.                RentaHeureUSM = CurCell.Offset(0, 8).Value / TempsPos
  1429.                
  1430.                
  1431.             End If
  1432.         End If
  1433.     End If
  1434.    
  1435.     'Choix du type de renta à afficher en fonction des choix de l'utilisateur
  1436.    Select Case ChoixTypeRenta
  1437.         Case "Brute"
  1438.             CurCell.Offset(0, 9).Value = RentaHeureBrute
  1439.         Case "USM"
  1440.             CurCell.Offset(0, 9).Value = RentaHeureUSM
  1441.         Case Else
  1442.             MsgBox ("Merci d'indiquer Brute ou USM dans la case P20")
  1443.     End Select
  1444. Next
  1445.  
  1446. 'Modification de l'intitulé de la colonne de rentahoraire en fonction des choix de l'utilisateur
  1447.  
  1448. Select Case ChoixTypeRenta
  1449.     Case "Brute"
  1450.         Range("K1").Value = "Profits/Heure Brute"
  1451.     Case "USM"
  1452.         Range("K1").Value = "Profits/Heure USM"
  1453.     Case Else
  1454.         MsgBox ("Merci d'indiquer Brute ou USM dans la case W20")
  1455. End Select
  1456.  
  1457.  
  1458.  
  1459. End Sub
  1460.  
  1461. Sub BoutonPT(BtnName As String)
  1462. '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
  1463.  
  1464.     BtnName = BtnName + 1
  1465.     'MsgBox BtnName
  1466.    Set objWSH = CreateObject("WScript.Shell")
  1467.         Call objWSH.Run("""" & Range("P" & BtnName).Value & """")
  1468.     Range("P" & BtnName).Select
  1469.         With Selection.Interior
  1470.             .Pattern = xlUp
  1471.             .PatternThemeColor = xlThemeColorAccent3
  1472.             .ThemeColor = xlThemeColorAccent3
  1473.             .TintAndShade = 0.599963377788629
  1474.             .PatternTintAndShade = 0.399945066682943
  1475.         End With
  1476.     Set objWSH = Nothing
  1477. End Sub
  1478. Sub BoutonGT(BtnName As String)
  1479. '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
  1480.  
  1481.     BtnName = BtnName + 1
  1482.     'MsgBox BtnName
  1483.    Set objWSH = CreateObject("WScript.Shell")
  1484.         Call objWSH.Run("""" & Range("Q" & BtnName).Value & """")
  1485.     Range("Q" & BtnName).Select
  1486.         With Selection.Interior
  1487.             .Pattern = xlUp
  1488.             .PatternThemeColor = xlThemeColorAccent3
  1489.             .ThemeColor = xlThemeColorAccent3
  1490.             .TintAndShade = 0.599963377788629
  1491.             .PatternTintAndShade = 0.399945066682943
  1492.         End With
  1493.     Set objWSH = Nothing
  1494. End Sub
  1495.  
  1496. Sub create_buttons()
  1497. 'Cette macro est utilisée pour créer les boutons en colonne T et U
  1498.  
  1499. Dim I As Integer
  1500. Dim J As Integer
  1501. Dim Btn As Button
  1502. Dim Text As String
  1503.  
  1504. I = 2
  1505.  
  1506.  
  1507.  
  1508. ActiveSheet.Buttons.Delete
  1509. 'ButtonPT
  1510. For I = 2 To 600
  1511.     'Ival = "T" & I
  1512.    Set Btn = ActiveSheet.Buttons.Add(Range("T" & I).Left, Range("T" & I).Top, Range("T" & I).Width, Range("T" & I).Height)
  1513.     Btn.Name = I - 1
  1514.     'Lance la macro BoutonPT et envoie dans celle-ci le nom du bouton
  1515.    Btn.OnAction = "'BoutonPT """ & Btn.Name & """'"
  1516.     Btn.Text = "PT" & Btn.Name
  1517.     Text = Btn.Name
  1518. Next
  1519.  
  1520. Set Btn = Nothing
  1521. 'ButtonGT
  1522. For I = 2 To 600
  1523.     'Ival = "T" & I
  1524.    Set Btn = ActiveSheet.Buttons.Add(Range("U" & I).Left, Range("U" & I).Top, Range("U" & I).Width, Range("U" & I).Height)
  1525.     Btn.Name = I - 1
  1526.     'Lance la macro BoutonGT et envoie dans celle-ci le nom du bouton
  1527.    Btn.OnAction = "'BoutonGT """ & Btn.Name & """'"
  1528.     Btn.Text = "GT" & Btn.Name
  1529.     Text = Btn.Name
  1530. Next
  1531.  
  1532. Set Btn = Nothing
  1533.  
  1534. 'Others Buttons :
  1535. 'Create Board
  1536. Set Btn = ActiveSheet.Buttons.Add(Range("V25:W25").Left, Range("V25:W25").Top, Range("V25:W25").Width, Range("V25:W25").Height)
  1537. Btn.Text = "Créer Tableau / Create Board (Ctrl+B)"
  1538. Btn.OnAction = "'TriRenta'"
  1539. Set Btn = Nothing
  1540. 'Switch FR/EN
  1541. Set Btn = ActiveSheet.Buttons.Add(Range("AB20").Left, Range("AB20").Top, Range("AB20").Width, Range("AB20").Height)
  1542. Btn.Text = "Switch FR/EN"
  1543. Btn.OnAction = "'LanguageButton'"
  1544. Set Btn = Nothing
  1545. 'Remove Buttons
  1546. Set Btn = ActiveSheet.Buttons.Add(Range("AB22").Left, Range("AB22").Top, Range("AB22").Width, Range("AB22").Height)
  1547. Btn.Text = "Remove Buttons"
  1548. Btn.OnAction = "'Remove_Buttons'"
  1549.  
  1550. End Sub
  1551.  
  1552. Sub Remove_Buttons()
  1553.  
  1554. 'This sub is useful if you want to remove buttons (to use the table in a program that doesn't read buttons)
  1555. ActiveSheet.Buttons.Delete
  1556.  
  1557. End Sub
  1558.  
  1559.  
  1560.  
  1561. Sub LanguageButton()
  1562.  
  1563. 'Cette Macro est affectée au Bouton "SwitchLanguage"
  1564.  
  1565. Dim Langue As String
  1566.  
  1567. Langue = Range("Z14").Value
  1568.  
  1569. Select Case Langue
  1570.     Case "FR"
  1571.         'Configuration
  1572.        Range("Y1").Value = "|-- Configuration --|"
  1573.         Range("Y2").Value = "Http ou Https ?"
  1574.         Range("Y3").Value = "Univers : (ex : s60-fr)"
  1575.         Range("Y4").Value = "Nombre de Slots"
  1576.         Range("Y5").Value = "Minimum pour créer une 2nd vague"
  1577.         Range("Y6").Value = "Supprimer les flottes dont la valeur dépasse en points…"
  1578.         Range("Y7").Value = "Supprimer les Défenses dont la valeur dépasse en points…"
  1579.         Range("Y8").Value = "Vitesse flotte de l'univers (mettre 1,2 ou 3 ou 4…)"
  1580.         Range("Y9").Value = "Nombre de galaxies dans l'univers"
  1581.         Range("Y10").Value = "Nombre de systèmes solaires dans l'univers"
  1582.         Range("Y11").Value = "Univers Circulaire ? Répondre par Oui ou Non"
  1583.         Range("Y12").Value = "Combien de fois plus de vaisseaux que nécessaire ?** "
  1584.         Range("Y13").Value = "Trier les ressources en fonction de la colonne… (ex : F)"
  1585.         Range("Y14").Value = "Langue"
  1586.        
  1587.         'Statistiques
  1588.        Range("V1").Value = "|- Statistiques -|"
  1589.         Range("V3").Value = "Total de la première vague : "
  1590.         Range("V4").Value = "PT nécessaires (1ère vague)"
  1591.         Range("V5").Value = "Moyenne par raid  : "
  1592.         Range("V7").Value = "Total seconde vague :"
  1593.         Range("V8").Value = "Moyenne par raid (2nd vague ) : "
  1594.         Range("V9").Value = "Total 3e vague :"
  1595.         Range("V10").Value = "Moyenne par raid (3ème vague ):"
  1596.         Range("V13").Value = "Moyenne par raid (total des RE) :"
  1597.         Range("V14").Value = "Nombre Total de RE : "
  1598.        
  1599.         'Sous les statistiques
  1600.        
  1601.         Range("V17").Value = "Coordonnée de départ (ex : 9:158:3) :"
  1602.         Range("V18").Value = "Techs (combu,impu,prop)  *"
  1603.         Range("V19").Value = "Entrer PT ou GT ou RIP *** "
  1604.         Range("V20").Value = "Renta horaire (Entrer Brute ou USM) "
  1605.         Range("V21").Value = "Taux de commerce (Pour l'USM)"
  1606.        
  1607.         'Tableau
  1608.        Range("C1").Value = "Joueur"
  1609.         Range("D1").Value = "Ressources"
  1610.         Range("E1").Value = "Métal"
  1611.         Range("F1").Value = "Cristal"
  1612.         Range("G1").Value = "Deutérium"
  1613.         Range("I1").Value = "Rentabilité"
  1614.         Range("J1").Value = "Renta USM"
  1615.         Range("L1").Value = "Flotte"
  1616.         Range("M1").Value = "Défense"
  1617.         Range("N1").Value = "NbPT"
  1618.         Range("O1").Value = "NbGT"
  1619.         Range("P1").Value = "Lien PT"
  1620.         Range("Q1").Value = "Lien GT"
  1621.         Range("S1").Value = "Lancé?"
  1622.        
  1623.     Case Else
  1624.    
  1625.         'Configuration
  1626.        Range("Y1").Value = "|-- Options --|"
  1627.         Range("Y2").Value = "Http or Https ?"
  1628.         Range("Y3").Value = "Universe : (ex : s60-fr)"
  1629.         Range("Y4").Value = "Amount of fleet slots"
  1630.         Range("Y5").Value = "Minimum profits to create a next wave"
  1631.         Range("Y6").Value = "Delete the line when the fleet amount is higher than... (amount /1000) "
  1632.         Range("Y7").Value = "Delete the line when the def amount is higher than... (amount /1000)"
  1633.         Range("Y8").Value = "Fleet speed of the universe (put 1, or 2, or 3...)"
  1634.         Range("Y9").Value = "Amount of galaxies in your universe"
  1635.         Range("Y10").Value = "Amount of solar systems per galaxies"
  1636.         Range("Y11").Value = "Circular Universe ? Choose Oui or Non "
  1637.         Range("Y12").Value = "How many more ships do you want to send?** "
  1638.         Range("Y13").Value = "Sort the table with column… (ex : F)"
  1639.         Range("Y14").Value = "Language"
  1640.        
  1641.         'Statistiques
  1642.        Range("V1").Value = "|- Stats -|"
  1643.         Range("V3").Value = "Profits in first wave : "
  1644.         Range("V4").Value = "Light Cargos (1st wave)"
  1645.         Range("V5").Value = "Average per attack  : "
  1646.         Range("V7").Value = "Profits in second wave :"
  1647.         Range("V8").Value = "Average per attack (2nd wave) : "
  1648.         Range("V9").Value = "Profits in 3rd wave :"
  1649.         Range("V10").Value = "Average per attack (3rd wave):"
  1650.         Range("V13").Value = "Average per attack (For all SR) :"
  1651.         Range("V14").Value = "Amount of Spy Reports : "
  1652.        
  1653.         'Sous les statistiques
  1654.        
  1655.         Range("V17").Value = "Your coords (ex : 9:158:3) :"
  1656.         Range("V18").Value = "Speed of your ships (combu,impu,hyper)  *"
  1657.         Range("V19").Value = "Enter PT or GT or RIP *** "
  1658.         Range("V20").Value = "Profits/ hour (Enter Brute or USM) "
  1659.         Range("V21").Value = "Trade Rate (for USM)"
  1660.        
  1661.         'Tableau
  1662.        Range("C1").Value = "Player"
  1663.         Range("D1").Value = "Resources"
  1664.         Range("E1").Value = "Metal"
  1665.         Range("F1").Value = "Crystal"
  1666.         Range("G1").Value = "Deuterium"
  1667.         Range("I1").Value = "Profits"
  1668.         Range("J1").Value = "Profits USM"
  1669.         Range("L1").Value = "Fleet"
  1670.         Range("M1").Value = "Defence"
  1671.         Range("N1").Value = "Amount Light Cargo"
  1672.         Range("O1").Value = "Amount Large Cargo"
  1673.         Range("P1").Value = "Link Light C"
  1674.         Range("Q1").Value = "Link Large C"
  1675.         Range("S1").Value = "Launched?"
  1676.        
  1677.    
  1678.        
  1679. End Select
  1680.        
  1681.  
  1682.  
  1683.  
  1684. End Sub
  1685.  
  1686.  
  1687.  
  1688.  
  1689.  
  1690. Sub ColorAttack()
  1691.  
  1692. '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.
  1693.  
  1694. Range(ActiveCell.Address).Select
  1695.             With Selection.Interior
  1696.                 .Pattern = xlUp
  1697.                 .PatternThemeColor = xlThemeColorAccent3
  1698.                 .ThemeColor = xlThemeColorAccent3
  1699.                 .TintAndShade = 0.599963377788629
  1700.                 .PatternTintAndShade = 0.399945066682943
  1701.             End With
  1702.  
  1703. End Sub
RAW Paste Data