CONNEXION
  • RetourJeux
    • Sorties
    • Hit Parade
    • Les + populaires
    • Les + attendus
    • Soluces
    • Tous les Jeux
    • Gaming
  • RetourActu Gaming
    • News
    • Astuces
    • Tests
    • Previews
    • Toute l'actu gaming
  • RetourBons plans
    • Bons plans
    • Bons plans Smartphone
    • Bons plans Hardware
    • Bons plans Image et Son
    • Bons plans Amazon
    • Bons plans Cdiscount
    • Bons plans Decathlon
    • Bons plans Fnac
    • Tous les Bons plans
  • RetourJVTech
    • Actus High-Tech
    • Intelligence Artificielle
    • Smartphones
    • Mobilité urbaine
    • Hardware
    • Image et son
    • Tutoriels
    • Tests produits High-Tech
    • Guides d'achat High-Tech
    • JVTech
  • RetourCulture
    • Actus Culture
    • Culture
  • RetourVidéos
    • A la une
    • Gaming Live
    • Vidéos Tests
    • Vidéos Previews
    • Gameplay
    • Trailers
    • Chroniques
    • Replay Web TV
    • Toutes les vidéos
  • RetourForums
    • Hardware PC
    • PS5
    • Switch 2
    • Xbox Series
    • Switch
    • Pokemon pocket
    • FC 25 Ultimate Team
    • League of Legends
    • Tous les Forums
  • PC
  • PS5
  • Xbox Series
  • Switch 2
  • PS4
  • One
  • Switch
  • iOS
  • Android
  • MMO
  • RPG
  • FPS
En ce moment Genshin Impact Valhalla Breath of the wild Animal Crossing GTA 5 Red dead 2
Liste des sujets

[HELP] Excel VBA

leodarth
leodarth
Niveau 10
02 janvier 2013 à 16:05:35

Bonjour à tous,

Je suis étudiant à l'université et j'ai un sacré problème...

Pour notre cours d'informatique, nous devons faire une base de données via Access, puis la transférer vers Excel... Avec, évidemment, beaucoup de consignes... Nous sommes parvenus à tout faire excepté nos traitements VBA... On ne parvient pas à les faire fonctionner Nous devons rendre notre travail demain ainsi que notre rapport pour 16H au plus tard... Nous sommes vraiment mal barré et je fais donc un appel au secours en espérant qu'une âme charitable pourra nous aider...
Les codes sont déjà fait mais ça foire quand on les exécute....

Je vous en supplie... Quelqu'un pourrait-il nous consacrer un tout petit peu de son temps pour vérifier et corriger nos code ? Je peux également transférer mon fichier excel pour que ça soit plus clair....

Je vous remercie d'avance....
leodarth

http://img203.imageshack.us/img203/7821/excelh.png
Voici la fiche qui bug...
IOn a actuellement un tableau excel plein de données issues d'Access (donc surtout ne pas changer ces données) sinon les deux programmes ne corresponderaient plus.

On a du, pour excel, faire des traitements statistiques (faits) et des représentation graphiques (fait aussi)

Il ne nous reste plus qu'à, via des Macros (en excell c'est donc simplement un moyen pour faire des programmes automatiques, pas hyper compliqués je pense.) J'en ai déjà réalisé deux assez semblables, qui présentent un petit defaut c'est que je n'arrive pas à faire demarrer les "ordres" par defaut de la bonne case pour rendre le remplissage des cases semi automatique correct quel que soit la "Active Cell" au momenrt de lancer la macro (et de pousser sur le bouton donc, car on relie chaque programmation VBA (macro) à un bouton) (Tres simple à faire) J'ai commencé un programme dans lequel je voulais faire que toutes les donnees au dessus d'un chiffre (la moyenne dans notre cas) se mettent en une couleur et tout celles en dessous de la colonne total de la feuille "Fiches d'entretien" en une autre colonne

Voici les codes qu'on a utilisé pour ce faire :
Sub Total_Entretien()

Dim rng_total As Range
Dim compteur As Integer

Set rng_total = Sheets("Fiches_d'entretien" ).Range("rng_Total" )

compteur = 1

'La boucle commence ici
For Each valeir_total In rng_total
If valeur_total < 500 Then
Sheets("Fiches_d'entretien" ).Cells(compteur, 13).Value = "Petite réparation"
Else
Sheets("Fiches_d'entretien" ).Cells(compteur, 13).Value = "Grosse Réparatoin"
End If
compteur = compteur + 1
'On termine finit la boucle
Next

End Sub
Sub Somme_si_Couleurs()

'déclaration

Dim rng_total As Range
Dim compteur As Integer
Dim moyenne_compteur As Integer
Dim somme_total As Variant
Dim Moyenne_total As Variant

'Initialisation

Set rng_total = Sheets("Fiches_d'entretien" ).Range("rng_Total" )

compteur = 1
moyenne_compteur = 0
somme_total = 0

'On calcule la moyenne des la colonne Total

For Each valeur_total In rng_total
moyenne_compteur = moyenne_compteur + 1
somme_total = somme_total + valeur_solde
Next

Moyenne_total = somme_total / (moyenne_compteur)

'On donne une couleur aux cases

For Each valeur_total In rng_total
If valeur_total < Moyenne_total Then
Sheets("Fiches_d'entretien" ).Cells(compteur, 12).Font.ColorIndex = 20
Else
Sheets("Fiches_d'entretien" ).Cells(compteur, 12).Font.ColorIndex = 30
End If

compteur = compteur + 1

Next

End Sub

Et mon module (qui ne marche pas) :
Sub Macro1()

' Macro1 Macro

Range("L2,L3,L5,L7,L6,L8,L9,L10,L1," ).Select
Range("L2" ).Activate
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("G38" ).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("L4,L11,L14,L16,L21,G39" ).Select
Range("L4" ).Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("G39" ).Select
End Sub

Sub entretien_inférieur_moyenne()
'
' Entretien inférieur à la moyenne
'

'
Range("L2:L3" ).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("L5:L6:L8:L9:L10:L12:L13:L15:L17:L18:L19:L20

"
).Select
Range("G38" ).Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub Entretien_suppérieur_moyenne()
'
' Entretien Suppérieur à la moyenne
'

'
Range("L4" ).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("L7:L11:L14:L16:L21" ).Select
Range("G39" ).Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("K29" ).Select
End Sub

leodarth
leodarth
Niveau 10
02 janvier 2013 à 16:08:20

Pour le bouton "ajouter client" où la cellule doit se mettre automatiquement à la suite du tableau :
Sub ajouterclient()

ActiveCell.FormulaR1C1 = ActiveCell.Offset(-1, 0).Value + 1
ActiveCell.Offset(0, 1).Select

' Encode le nom de la personne
Nom = InputBox("Entrez le nom du nouveau client")
ActiveCell.FormulaR1C1 = Nom
ActiveCell.Offset(0, 1).Select

' Encode le prénom de la personne
Prénom = InputBox("Entrez le prénom du client")
ActiveCell.FormulaR1C1 = Prénom
ActiveCell.Offset(0, 1).Select

' Encode l'adresse
Adresse = InputBox("Entrez l'adresse du nouveau client")
ActiveCell.FormulaR1C1 = Adresse
ActiveCell.Offset(0, 1).Select

' Encode le code postal
Codepostal = InputBox("Entrez le code postal du nouveau client (B-****)")
ActiveCell.FormulaR1C1 = Codepostal
ActiveCell.Offset(0, 1).Select

' Encode la ville
Ville = InputBox("Entrez la ville du nouveau client")
ActiveCell.FormulaR1C1 = Ville
ActiveCell.Offset(0, 1).Select

' Encode le sexe du client
Sexe = InputBox("Entrez le sexe du client (Homme/Femme)")
ActiveCell.FormulaR1C1 = Sexe
ActiveCell.Offset(0, 1).Select

' Encode la date de naissance du client
Naissance = InputBox("Entrez la date de naissance du client (**/**/****)")
ActiveCell.FormulaR1C1 = Naissance
ActiveCell.Offset(0, 1).Select

' Encode le Numéro de Fixe du client
Fixe = InputBox("Entrez le Numéro de téléphone fixe")
ActiveCell.FormulaR1C1 = Fixe
ActiveCell.Offset(0, 1).Select

' Encode le Numéro du gsm du client
Gsm = InputBox("Entrez le Numéro de Gsm client")
ActiveCell.FormulaR1C1 = Gsm
ActiveCell.Offset(0, 1).Select

' Encode le type de client
Typeclient = InputBox("Entrez le type de client (Particulier/Professionnel)")
ActiveCell.FormulaR1C1 = Typeclient
ActiveCell.Offset(0, 1).Select

End Sub

Sous forums
  • Aide à l'achat Mac
  • Internet
  • Macintosh
  • Création de sites web
  • Création de Jeux
  • Linux
  • Programmation
  • Steam Deck
  • Hardware
La vidéo du moment