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

Question

Bonjour,

Je dois enregistrer plusieurs fichiers excel, dans ces derniers, je mets dans un tableau les valeurs issus de fichiers. Jusque l&#224;, pas de pb. Par contre, j'aimerais s&#233;lectionner certaines cases pour les colorier ou faire un graphique mais quand j'&#233;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&#232;me it&#233;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&#233;soudre ce probl&#232;me assez g&#234;nant ?

Merci pour votre aide.

econs · Answer

Euh ... il n'y a pas de boucle dans le code que tu as donné... Le code suivant fonctionne très bien sous Excel : ~~Xl.ActiveWorkbook.Sheets(aujourdhui).Activate~~ ActiveWorkbook.Sheets(1).Range("A13:E25").Select With Selection.Interior .ColorIndex = 3 .Pattern = xlSolid End With Attention au point '.' devant Pattern Manu

gradenko80 · Answer

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.

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

2 réponses

Discussions similaires