Sélection de cases dans excel (Boucle ne fonctionnant qu'une fois!?!)

Messages postés
9
Date d'inscription
lundi 19 juillet 2004
Statut
Membre
Dernière intervention
29 mars 2006
-
Messages postés
9
Date d'inscription
lundi 19 juillet 2004
Statut
Membre
Dernière intervention
29 mars 2006
-
Bonjour,

Je dois enregistrer plusieurs fichiers excel, dans ces derniers, je mets dans un tableau les valeurs issus de fichiers. Jusque là, pas de pb. Par contre, j'aimerais sélectionner certaines cases pour les colorier ou faire un graphique mais quand j'écris le code ci dessous (VB6) la boucle ne fonctionne qu'une seule fois, j'ai une erreur avec le With lors de la deuxième itération.

Xl.ActiveWorkbook.Sheets(aujourdhui).Activate
Xl.ActiveWorkbook.Sheets(1).Range("A13:E25").Select


With Selection.Interior
.ColorIndex = 3
Pattern = xlSolid
End With

Pourriez svp me dire pourquoi et le code que je dois taper pour résoudre ce problème assez gênant ?

Merci pour votre aide.

2 réponses

Messages postés
4030
Date d'inscription
mardi 13 mai 2003
Statut
Modérateur
Dernière intervention
23 décembre 2008
22
Euh ... il n'y a pas de boucle dans le code que tu as donné...






Le code suivant fonctionne très bien sous Excel :



<strike>Xl.ActiveWorkbook.Sheets(aujourdhui).Activate</strike>

ActiveWorkbook.Sheets(1).Range("A13:E25").Select



With Selection.Interior

.ColorIndex = 3

.Pattern = xlSolid

End With




Attention au point '.' devant Pattern




Manu
Messages postés
9
Date d'inscription
lundi 19 juillet 2004
Statut
Membre
Dernière intervention
29 mars 2006

Voici mon code: (dsl pas eu le temps de mettre de commentaires)

Cette fonction est appelée par un Timer


Public Sub recopie_etat(adresse As String, nom_machine As Variant, num_machine As String)


intnumfic = FreeFile


Open adresse For Input As intnumfic


Line Input #intnumfic, réf


Line Input #intnumfic, qté


Line Input #intnumfic, pos


Line Input #intnumfic, lig


Line Input #1, dateheur


jr = Mid(dateheur, 1, 10)


hr = Mid(dateheur, 12, 8)


Close intnumfic


If hr_pr_excel >= "07:15" And hr_pr_excel <= "07:25" Then


If enregistrement_excel(num_machine) <> 1 Then


Set Xl = New Excel.Application


Set fs = CreateObject("Scripting.FileSystemObject")


Xl.Visible = True


Pathfic = "C:\Documents and Settings\Administrateur\Bureau\isa\donneeserp" + num_machine + ".xls"


If fs.FileExists("C:\Documents and Settings\Administrateur\Bureau\isa\donneeserp" + num_machine + ".xls") = False Then


creation(num_machine) = 0


Else


creation(num_machine) = 1


End If


If creation(num_machine) = 0 Then


Xl.Workbooks.Add


Xl.ActiveWorkbook.Sheets.Add


Xl.ActiveWorkbook.Sheets.Add


Xl.ActiveWorkbook.Sheets.Add


Xl.ActiveWorkbook.Sheets.Add


Xl.ActiveWorkbook.Sheets.Add


Xl.ActiveWorkbook.Sheets.Add


Xl.ActiveWorkbook.Sheets.Add


creation(num_machine) = 1


Pathfic = "C:\Documents and Settings\Administrateur\Bureau\isa\donneeserp" + num_machine + ".xls"


Xl.Application.DisplayAlerts = False


Xl.ActiveWorkbook.SaveAs Pathfic


Xl.ActiveWorkbook.Close


Xl.Quit


Set Xl = Nothing


End If


Set Xl = New Excel.Application


Xl.Visible = False


Xl.Application.Workbooks.Open Pathfic


numero_jour = Mid(Date, 1, 2)


numero_mois = Mid(Date, 4, 2)


indication_jour = numero_jour + "-" + numero_mois


aujourdhui = Weekday(Date)


Select Case aujourdhui


Case 1


nom_jour = "Dim " + indication_jour


Xl.ActiveWorkbook.Sheets(1).Name = nom_jour


Case 2


nom_jour = "Lun " + indication_jour


Xl.ActiveWorkbook.Sheets(2).Name = nom_jour


Case 3


nom_jour = "Mar " + indication_jour


Xl.ActiveWorkbook.Sheets(3).Name = nom_jour


Case 4


nom_jour = "Mer " + indication_jour


Xl.ActiveWorkbook.Sheets(4).Name = nom_jour


Case 5


nom_jour = "Jeu " + indication_jour


Xl.ActiveWorkbook.Sheets(5).Name = nom_jour


Case 6


nom_jour = "Ven " + indication_jour


Xl.ActiveWorkbook.Sheets(6).Name = nom_jour


Case 7


nom_jour = "Sam " + indication_jour


Xl.ActiveWorkbook.Sheets(7).Name = nom_jour


End Select


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("a" & 1).Value = "Tranche horaire"


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("b" & 1).Value = "Tps arrêt"


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("c" & 1).Value = "Tps manu"


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("d" & 1).Value = "Tps auto"


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("e" & 1).Value = "Tps inconnu"


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("f" & 1).Value = "Référence"


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("g" & 1).Value = "Tps arret + manu"


"Problème à partir de ce niveau lorsque je passe de la machine 1 à la machine 2 ...


"Pour la récupération des données du fichier je n'ai aucun pb"


'Xl.ActiveWorkbook.Sheets(aujourdhui).Activate


'Xl.ActiveWorkbook.Sheets(aujourdhui).Range("A13:E25").Select


'With Selection.Interior


' .ColorIndex = 3


'Pattern = xlSolid


'End With


'MsgBox ("coucou")


Open "P:\Users\Devpt\BUILD\Maintenance\Temps\erptemps" + num_machine + ".val" For Input As #1


Do Until EOF(1)


Input #1, arret, manu, autom, inc, tranche_horaire, r


If tranche_horaire = "6h-7h" Then


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("a" & 2).Value = tranche_horaire


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("b" & 2).Value = arret


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("c" & 2).Value = manu


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("d" & 2).Value = autom


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("e" & 2).Value = inc


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("f" & 2).Value = r


End If


If tranche_horaire = "7h-8h" Then


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("a" & 3).Value = tranche_horaire


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("b" & 3).Value = arret


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("c" & 3).Value = manu


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("d" & 3).Value = autom


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("e" & 3).Value = inc


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("f" & 3).Value = r


End If


If tranche_horaire = "8h-9h" Then


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("a" & 4).Value = tranche_horaire


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("b" & 4).Value = arret


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("c" & 4).Value = manu


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("d" & 4).Value = autom


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("e" & 4).Value = inc


Xl.ActiveWorkbook.Sheets(aujourdhui).Range("f" & 4).Value = r


End If


Loop


Close #1


Xl.Application.DisplayAlerts = False


Xl.ActiveWorkbook.SaveAs Pathfic


enregistrement_excel(num_machine) = 1


Xl.ActiveWorkbook.Close


Xl.Quit


Set Xl = Nothing


End If

Merci de votre aide.