Excel 2003 VBA - метод для дублирования этого кода, который выделяет и окрашивает строки - PullRequest
Новая
       20

Excel 2003 VBA - метод для дублирования этого кода, который выделяет и окрашивает строки

2 голосов
/ 05 апреля 2010

, так что это фрагмент процедуры, которая экспортирует набор данных из доступа в Excel 

Dim rs As Recordset

Dim intMaxCol As Integer Dim intMaxRow As Integer Dim objxls As Excel.Application Dim objWkb As Excel.Workbook Dim objSht As 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

посмотри, где я смотрю на раскраску строк. Я хотел выбрать и заполнить (любым цветом) все остальные строки, как некоторые из этих отчетов о доступе. Я могу сделать это вручную, кодируя каждую строку, но две проблемы: 1) это больно, 2) я не знаю, что такое количество записей до руки.

Как я могу сделать код более эффективным в этом отношении, в то же время добавив счетчик записей, чтобы узнать, сколько строк нужно "пройти"

РЕДАКТИРОВАТЬ: Другой вопрос, который у меня есть, с методами выбора, которые я использую в модуле, есть ли лучший синтаксис Excel вместо этих с выборами ... 

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

- единственный способ выяснить, как выполнить этот кусок, но буквально каждый раз, когда я запускаю этот код, он терпит неудачу. Это говорит, что нет никакого объекта и указывает на .font .... каждый второй раз? это потому, что код плохой, или я не закрываю приложение xls в коде? если да, то как мне это сделать?

Спасибо как всегда!

Ответы [ 2 ]

2 голосов
/ 05 апреля 2010

Использовать условное форматирование. Вот небольшой кусок вашего кода, переписанный 

      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

Вы должны задать свой вопрос выбора в новом вопросе, но ответ будет таким: всякий раз, когда вы видите. Выберите, а затем С помощью выбора, вам, вероятно, не нужно выбирать. 

With Cells.Font
    .Name = "Calibri"
    .Size = 10
End With
0 голосов
/ 06 мая 2016

Вам не нужно выбирать весь диапазон для CopyfromRecordset, достаточно Range("A1").CopyfromRecordset rs, и для того, что я вижу, вы можете просто выбрать ваши данные вместо всех столбцов. 

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

И для второго вопроса @DickKusleika прав.

...