Programmation sous VBA

Salut,

Et avec ce chantage affectif, tu voudrais nous faire faire ton boulot ?
Tu veux ton diplôme ? Etudie ! T'es une bille ? Révise ! T'es vraiment mauvais ? Apprends !

Malgré cette entrée en matière un peu abrupte, je ne ferme pas ce topic bien que dans l'état actuel, il contrevienne au règlement. En effet tu pourrais - au lieu de nous demander de faire ton boulot, nous solliciter sur des points plus précis, avec des exemples, en nous montrant des trucs qui ne marchent pas bien qu'on pourrait te faire améliorer, etc.

Bonjour,
Je ne cherche en aucun cas a vous faire faire le boulot! La programmation est une matière qui me sera totalement inutile dans mon métier futur ( géomètre topographe) d'où mon manque d'investissement pour cette matière.
Voilà le fichier principal( que j'ai réalisé en bonne partie) :


[Public Tirage1 As Integer
Public ValeurObtenue As Integer
Public ValeurActuelle As Integer
Public Sub LancerDe()
Tirage1 = Int((6 * Rnd) + 1) + Int((6 * Rnd) + 1)
'Tirage1 = 1
Call DeplacerPion
Call MessageTirage

End Sub
Public Sub MessageTirage()
Dim Titre As String
Titre = "Tirage du Dé"
Select Case Tirage1
Case 2 To 12
MsgBox "Vous avancez de : " & Tirage1 & " Cases", , Titre
End Select
End Sub

Public Sub NouvellePartie()
Range("A2:J9").Select
Selection.Interior.ColorIndex = xlNone
Range("A2").Select
Selection.Interior.ColorIndex = 3

End Sub


Public Sub DeplacerPion()
ValeurActuelle = ActiveCell.Value
ValeurObtenue = ValeurActuelle + Tirage1
ValeurRecherchee = ValeurActuelle + 1
Select Case ValeurObtenue
Case Is < 73
Do While ValeurRecherchee < ValeurObtenue
Range("A2:J9").Select
Selection.Find(What:=ValeurRecherchee, After:=ActiveCell, MatchCase:=True).Select
ActiveCell.Interior.ColorIndex = 15
ValeurRecherchee = ValeurRecherchee + 1
Loop
Range("A2:J9").Select
Selection.Find(What:=ValeurObtenue, After:=ActiveCell, MatchCase:=True).Select
ActiveCell.Interior.ColorIndex = 16
Case Is > 73
MsgBox "Vous devez rejouer pour tomber PILE sur 73 "
Case Is = 73
Range("A2:J9").Select
Do While ValeurRecherchee <= ValeurObtenue
Range("A2:J9").Select
Selection.Find(What:=ValeurRecherchee, After:=ActiveCell, MatchCase:=True).Select
ActiveCell.Interior.ColorIndex = 5
ValeurRecherchee = ValeurRecherchee + 1
Loop
Selection.Find(What:=ValeurObtenue, After:=ActiveCell, MatchCase:=True).Select
ActiveCell.Interior.ColorIndex = 5
MsgBox "Bravo, vous gagnez la partie"
End Select

End Sub]

Ce fichier me permet d'avancer sur le plateau, mais il ne me permet pas de jouer a plusieurs et il n'intègre pas les cases bonus-malus. J'ai donc récupérer un fichier réalisant les fonctions manquantes:

[Option Explicit

Dim Joueurs(6) As New Joueur
Dim Plateau(73) As New Kase
Dim Bonus(12) As New BonusMalus
Dim Malus(4) As New BonusMalus
Dim i As Integer


Public Sub Init()

' initialise le plateau
Const Affectecase = "A1B1C1D1E1F1G1H1H2G2F2E2D2C2B2A2A3B3C3D3E3F3G3H3H4G4F4E4D4C4B4A4A5B5C5D5E5F5G5H5H6G6F6E6D6C6B6A6A7B7C7D7E7F7G7H7H8G8F8E8D8C8B8A8A9B9C9D9E9F9G9H9"

For i = 1 To 72
Plateau(i).Cellule = Mid(Affectecase, i * 2 - 1, 2)
ActiveSheet.Range(Mid(Affectecase, i * 2 - 1, 2)) = i
Next

' initialise les bonus
Bonus(1).Nom = "Boast"
Bonus(1).Déplus = 1
Bonus(2).Nom = "Replay"
Bonus(2).Rejouer = True
Bonus(3).Nom = "Invulnerable"
Bonus(3).Invulnerable = True
Bonus(4).Nom = "Bouclier"
Bonus(4).Reduit = 1
Bonus(5).Nom = "Armure"
Bonus(5).Reduit = 2
Bonus(6).Nom = "Reparation"
Bonus(6).Pvplus = 1
Bonus(7).Nom = "Mine"
Bonus(7).Pvmoins = 2
Bonus(8).Nom = "Frappe Aérienne"
Bonus(8).Pvmoins = 3 '?????????????????????????????????
Bonus(9).Nom = "Nova"
Bonus(9).Pvmoins = 2
Bonus(10).Nom = "Pistolet"
Bonus(10).Pvmoins = 1
Bonus(11).Nom = "Fusil"
Bonus(11).Pvmoins = 2
Bonus(12).Nom = "Canon"
Bonus(12).Pvmoins = 3

Malus(1).Nom = "Mines"
Malus(1).Pvmoins = 2
Malus(2).Nom = "Trous"
Malus(2).Bloque = True
Malus(3).Nom = "Sable"
Malus(3).Divise = 2
Malus(4).Nom = "Eau"
Malus(4).Divise = 3

End Sub

Public Function Jettedé()
Jettedé = Int(6 * Rnd) + 1
End Function

Public Function ordre()
' initialise les joueurs
Dim Nbjoueurs As Integer
Nbjoueurs = InputBox("Combien de joueurs (1 à 6)")
ActiveSheet.Range("K1") = Nbjoueurs
Dim i As Integer
Dim tmpnom As String
Dim cell As String
For i = 1 To Nbjoueurs
tmpnom = InputBox("Nom du joueur " & i & "?")
Joueurs(i).Nom = tmpnom
Joueurs(i).Vies = 6
ActiveSheet.Range("K" & (i + 1)) = tmpnom
ActiveSheet.Range("L" & (i + 1)) = Joueurs(i).Vies
Next
End Function]


Pour finir ce travail je n'ai donc plus qu'à intégrer le deuxième fichier dans le premier, chose que je n'arrive pas à faire. J'ai essayé en faisant du simple copier-coler mais sa ne fonctionne pas.
Je ne vous demande donc pas de faire mon travail, mais simplement de m'expliquer comment puis-je fusionner les deux fichiers.
Merci d'avance
Cordialement Adrien

Re salut Ad,

A la bonne heure. J'ai donc bien fait de ne pas fermer rageusement ce sujet.

Bon, mon rôle de modérateur m'impose de continuer à te faire chier   Si tu publies du code, il faut l'entourer des balises [code] [/code] (si tu ne me crois pas, va relire le règlement). Sinon, les ceux-ce qui sont susceptibles de t'aider dédaigneront lire ton code. Donc, merci de modifier ton message (C'est l'une des icônes en bas à droite du message incriminé).
En plus, en VBA, c'est généralement moi qui m'y colle, alors.

[315 c'est ma vie]
Un de mes meilleurs amis, coéquipier au rugby, donc compagnon de troisième mi-temps, et en plus camarade de chorale (genre petits chanteurs à la gueule de bois) - c'est dire combien nous sommes proches - est géomètre, et à son compte... Ah si tu savais combien l'informatique, il s'en tapait le coquillard. Sauf que maintenant, il faut qu'il s'y mette !