Excel 2003 VBA - méthode pour dupliquer ce code sélectionner et couleurs des lignes

Question

donc c'est un fragment d'une procédure qui exporte un ensemble de données de l'accès à exceller

Dim rs As Recordset 

Dim intMaxCol As Integer Dim intMaxRow As Integer Dim objxls Comme Excel.Application Dim objWkb Comme Excel.Workbook Dim objSht Comme Excel.Worksheet

Set rs = CurrentDb.OpenRecordset("qryOutput", dbOpenSnapshot) 

intMaxCol = rs.Fields.Count 
If rs.RecordCount > 0 Then 
    rs.MoveLast: rs.MoveFirst 
    intMaxRow = rs.RecordCount 
    Set objxls = New Excel.Application 
    objxls.Visible = True 
    With objxls 
     Set objWkb = .Workbooks.Add 
     Set objSht = objWkb.Worksheets(1) 
     With objSht 
      On Error Resume Next 
      .Range(.Cells(1, 1), .Cells(intMaxRow, intMaxCol)).CopyFromRecordset rs 
      .Name = conSHT_NAME 
      .Cells.WrapText = False 
      .Cells.EntireColumn.AutoFit 
      .Cells.RowHeight = 17 
      .Cells.Select 
       With Selection.Font 
        .Name = "Calibri" 
        .Size = 10 
       End With 

      .Rows("1:1").Select 
       With Selection 
       .Insert Shift:=xlDown 
       End With 
      .Rows("1:1").Interior.ColorIndex = 15 
      .Rows("1:1").RowHeight = 30 
      .Rows("2:2").Select 
       With Selection.Interior 
       .ColorIndex = 40 
       .Pattern = xlSolid 
       End With 
      .Rows("4:4").Select 
       With Selection.Interior 
       .ColorIndex = 40 
       .Pattern = xlSolid 
       End With 
      .Rows("6:6").Select 
       With Selection.Interior 
       .ColorIndex = 40 
       .Pattern = xlSolid 
       End With 

       .Rows("1:1").Select 
       With Selection.Borders(xlEdgeBottom) 
       .LineStyle = xlContinuous 
       .Weight = xlMedium 
       .ColorIndex = xlAutomatic 
       End With 
      End With 
     End With 
    End If 

    Set objSht = Nothing 
    Set objWkb = Nothing 
    Set objxls = Nothing 
    Set rs = Nothing 
    Set DB = Nothing 

End Sub 

voir où je regarde colorier les lignes. Je voulais sélectionner et remplir (avec n'importe quelle couleur) tous les deux rangs, un peu comme certains de ces rapports d'accès. Je peux le faire manuellement codant chaque rangée, mais deux problèmes: 1) c'est une douleur 2) je ne sais pas ce que le compte d'enregistrement est avant la main.

Comment puis-je rendre le code plus efficace à cet égard, tout en intégrant le recordcount de savoir combien de lignes à « boucle à travers »

EDIT: Une autre question que j'ai est avec les méthodes de sélection que je utilise dans le module , est-il une meilleure syntaxe Excel au lieu de ceux-ci avec des sélections ....

  .Cells.Select 
       With Selection.Font 
        .Name = "Calibri" 
        .Size = 10 
       End With 

est la seule façon que je figure sur la façon d'accomplir cette pièce, mais littéralement tout autre fois que je lance ce code, il échoue. Il dit qu'il n'y a aucun objet et pointe vers le .font .... toutes les autres fois? Est-ce parce que le code est mauvais, ou que je ne ferme pas l'application xls dans le code? si oui, comment puis-je faire cela?

Merci comme toujours!

Answer 1

Utiliser la mise en forme conditionnelle. Voici un petit morceau de votre code réécrite

 On Error Resume Next 
     With .Range(.Cells(1, 1), .Cells(intMaxRow, intMaxCol)) 
      .CopyFromRecordset rs 
      .FormatConditions.Add xlExpression, , "=MOD(ROW(),2)=1" 
      With .FormatConditions(1) 
       .Interior.Color = vbYellow 
      End With 
     End With 

Vous devriez demander à votre question de sélection dans une nouvelle question, mais la réponse sera: chaque fois que vous voyez .Choisir suivi avec la sélection, vous n'avez probablement pas besoin de sélectionner .

With Cells.Font 
    .Name = "Calibri" 
    .Size = 10 
End With 

Answer 2

Vous n'avez pas besoin de sélectionner toute la gamme pour CopyfromRecordset, juste Range("A1").CopyfromRecordset rs est enought et pour ce que je vois, vous pouvez simplement sélectionner vos données au lieu de toutes les colonnes.

For i = 2 to 6 Step 2 
    With Range(Cells(1,i),Range(Cells(1,i)).End(xlDown)).Interior 
     .ColorIndex = 40 
     .Pattern = xlSolid 
    End With 
Next i 

Et pour la deuxième question, @DickKusleika a raison.