Access 데이터베이스에서 VBA를 사용하여 Excel 시트 행 강조 표시

Question

Access 데이터베이스에서 Excel의 범위에있는 모든 n 번째 행을 강조 표시하는 루틴을 개발하려고 시도해 왔습니다.

이렇게하면 포함 된 Excel 기능을 최대한 활용하므로 주제별로 다양한 코드 제공이 필요하지 않습니다.

아래 코드는 작동하도록 올바른 매개 변수 구조를 찾을 수 있기를 기대하면서 테스트 용으로 사용한 내 Access VBA의 독립 실행 형 추출입니다. 따라서이 매크로에는 Excel 매크로로 직접이 매크로를 포함하는 경우 필요하지 않은 Dim 문 등이 코드에 포함됩니다.

다른 모든 행을 선택했지만 어떤 이유로 든 의도 한 범위의 첫 번째 열만 선택하면됩니다. 나는이 문제를 해결할 수 없었고 formating 과정에서 다른 컬럼을 포함시킬 수 없었다.

도움을 주시면 감사하겠습니다.

Sub xxx() 
Dim xlbook As Excel.Workbook 
Dim xlRng As Range 
Dim xlFinalRange As Range 
Dim intColumnCount As Integer 
Dim introwcount As Integer 
Dim strTable As String 

Set xlbook = Excel.ThisWorkbook 

strTable = "Sheet1" 
introwcount = 20 
intColumnCount = 14 


Set xlFinalRange = Sheets(strTable).Range("A4") 
xlFinalRange.Resize(1, intColumnCount).Select 
Set xlRng = Sheets(strTable).Range("A4") 
xlRng.Resize(1, intColumnCount).Select 
intRowsBetween = 2 

For i = 0 To introwcount 
    Set xlRng = xlRng.Offset(intRowsBetween, 0) 
    xlRng.Resize(1, intColumnCount).Select 
    Set xlFinalRange = xlbook.Application.Union(xlFinalRange, xlRng) 
    xlFinalRange.Resize(1, intColumnCount).Select 
    i = i + (intRowsBetween - 1) 
Next i 

xlFinalRange.Select 

    With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorAccent1 
     .TintAndShade = 0.799981688894314 
     .PatternTintAndShade = 0 
    End With 

End Sub 

Answer 1

가장 좋은 방법은 루프에 적절한 Step를 추가하는 것입니다. 또한, 제대로 모든 자격 : Range는 다음을 시도 등 Excel.Range해야한다 :

이

Sub HighlightXL() 

    Dim WBK As Excel.Workbook 
    Dim WS As Excel.Worksheet 
    Dim Iter As Long 
    Dim CombinedRng As Excel.Range, IterRng As Excel.Range 

    Excel.Application.Visible = True 
    Set WBK = Excel.Workbooks.Add 'Modify as necessary. 
    Set WS = WBK.Sheets("Sheet1") 'Modify as necessary. 

    With WS 
     For Iter = 1 To 22 Step 3 '1, 4, 7, 9... etc... 
      Set IterRng = .Cells(Iter, 1).Resize(1, 5) 'Resize to 14 in your case. 
      If CombinedRng Is Nothing Then 
       Set CombinedRng = IterRng 
      Else 
       Set CombinedRng = Union(CombinedRng, IterRng) 
      End If 
     Next Iter 
    End With 

    CombinedRng.Interior.ColorIndex = 3 'Red. 

End Sub 

스크린 샷 :

이 도움이되는지 알려 주시기 바랍니다. :)

Answer 2

나는 약간 다른 접근법을 과거에 취했습니다.

Sub ColourSheet() 

Dim ApXL As Object, xlWBk As Object, xlWSh As Object, _ 
    rng As Object, c As Object 
Dim strSheet As String, strFile As String 
Dim iColourRow As Integer, iRows As Integer, _ 
    iCols As Integer, x As Integer, iStartRow As Integer 

strFile = "C:\YourFolder\YourFile.xlsx" 
strSheet = "SheetName" 

iColourRow = 3 
iRows = 30 
iCols = 10 
iStartRow = 2 

If SmartGetObject("Excel.Application") Then 
    'excel open 
    Set ApXL = GetObject(, "Excel.Application") 
Else 
    Set ApXL = CreateObject("Excel.Application") 
End If 

Set xlWBk = ApXL.Workbooks.Add 
'Set xlWBk = ApXL.Workbooks.Open(strFile) 

Set xlWSh = xlWBk.activesheet 
'Set xlWSh = xlWBk.Worksheets(strSheet) 

For x = 1 To iRows 
    If x Mod iColourRow = 0 Then 
     With xlWSh.range(xlWSh.cells(iStartRow + x - 1, 1), _ 
      xlWSh.cells(iStartRow + x - 1, iCols)).interior 
      .Pattern = xlSolid 
      .PatternColorIndex = xlAutomatic 
      '.ThemeColor = xlThemeColorAccent1 
      .Color = 255 
      .TintAndShade = 0.799981688894314 
      .PatternTintAndShade = 0 
     End With 
    End If 
Next x 

ApXL.Visible = True 

End Sub 

몇 가지 참고 사항 : 아래는 내가 사용하는 것이 무엇 당신이 VBA 빨리 참조 사용하는 경우, 나는 엑셀에 대한 참조 바인딩을 늦게 사용 권합니다 데이터베이스를 배포하려는 경우에 특히

이상 사람입니다 데이터베이스가 작동을 멈추고 누락 된 참조로 인해 결론에 도달하게됩니다. Late Binding을 검색하면 주제를 충분히 볼 수 있습니다. 늦은 바인딩을 사용하면 xlThemeColorAccent1과 같은 변수를 얻지 못하며 Excel VBA 인스턴스 등을 열지 않아도 항상 가져올 수 있습니다.

Excel이 이미 실행되고 있는지 확인하는 함수 호출 GetSmartObject를 사용했습니다. 문제는 내가 추가로 Excel 인스턴스를 열고 오류를 치고 그 인스턴스가 백그라운드에서 실행 중임을 알게 된 후 작업 관리자로 가서 닫아야합니다.

마지막으로 방금 지정한 파일을 열고 시트를 설정 한 다른 통합 문서를 열어 보았습니다. 새 통합 문서를 열고 활성 시트를 사용하는 것이 더 쉬웠다 고 테스트했습니다.

희망이 다른 곳에 속하는 위의 기능에 대한

Function SmartGetObject(sClass As String) As Integer 
     Dim oTmpObject As Object 

     ' If Server running, oTmpObject refers to that instance. 
     ' If Server not running Error 429 is generated. 
     On Error Resume Next 
     Set oTmpObject = GetObject(, sClass) 
     ' oTmpObject is reference to new object. 
     If Err = 429 Then 
     SmartGetObject = False 
     Exit Function 
     ' Server not running, so create a new instance: 
     'Simon noted out: Set oTmpObject = GetObject("", sClass) 
     ' NOTE: for Excel, you can add the next line to view the object 
     ' oTmpObject.Visible = True 
     ElseIf Err > 0 Then 
     MsgBox Error$ 
     SmartGetObject = False 
     Exit Function 
     End If 
     Set oTmpObject = Nothing 
     SmartGetObject = True 
End Function 

신용 도움하지만 난 사람이 말해 줄 수 있다면 나는 그것을 제대로 신용거야 어디에서 왔고, 너무 오래 모르겠어요 했어 앞으로는.

Answer 3

Option Compare Database 

명시 적 옵션

하위 ExporttoExcel() 나는 목표를 달성하기 위해 두 답변의 조합을 사용하여 결국

Dim i As Integer 
Dim y As Integer 
Dim varArray As Variant   'Used for obtaining the Names of the Sheets from the DB being exported 
Dim varField As Variant   'Used for Naming of the Sheets being exported 
Dim dbs As DAO.Database 
Dim rst1 As DAO.Recordset  'DB Recordset for the Input and Output information 
Dim rst2 As DAO.Recordset  'DB Recordset for the Table names to be exported and sheet names in Excel 
Dim rst3 As DAO.Recordset  'DB Recordset that is reused for each Table being exported 
Dim strFile As String   'Used for the name and location of the Excel file to be saved 
Dim strTable As String   'Table name being exported and also used for the Sheet name 
Dim strTitle As String   'Title for the Data on each sheet 
Dim xlApp As Object 
Dim xlBook As Object 
Dim xlSheet As Object 
Dim xlRunning As Boolean  'Flag to identify that Excel is running or not 
Dim intColumnCount As Integer 'The number of columns on a sheet for formatting 
Dim intRowCount As Integer  'The number of rows on a sheet for formatting 
Dim intStartRow As Integer  'The row from which to start the highlighting process 
Dim intRowsBetween As Integer 'The number of rows between highlighting 


If SmartGetObject("Excel.Application") Then 
    Set xlApp = GetObject(, "Excel.Application") 'Excel is already open so the existing instance will be used 
    xlRunning = True 
Else 
    Set xlApp = CreateObject("Excel.Application") 'Excel is not open so an instance will be created 
    xlRunning = False 
End If 

Set xlBook = xlApp.Workbooks.Add 

xlApp.Visible = True 

xlApp.DisplayAlerts = False 

Set dbs = CurrentDb 

'Retrieve Study Location and Name for Import to Database 

Set rst1 = dbs.OpenRecordset("StudyTarget") 
strFile = rst1!OutputFile 
' Removed VBA for File Name & Save Path Information 
With xlBook 
    Set rst2 = dbs.OpenRecordset("ExportTableGroup", dbOpenSnapshot) 
    ' Removed VBA for Excel Naming information from DB 

    For y = 0 To rst2.RecordCount - 1 

     strTable = varArray(y, 1) 
     strTitle = varArray(y, 2) 

     Set rst3 = dbs.OpenRecordset(strTable, dbOpenTable) 
     .Sheets.Add after:=Sheets(Sheets.Count) 
     .Sheets(Sheets.Count).Name = strTable 
     Set xlSheet = .ActiveSheet 

    'COPY the Access Table Data to the Named Worksheet 

     xlSheet.Cells(2, 1).CopyFromRecordset rst3 

    'Select every X number of rows between sheet Data Rows on Worksheet to highlight 

     intRowsBetween = 2 
     intStartRow = 4 

     For i = 0 To intRowCount Step intRowsBetween 
      If xlSheet.Cells(intStartRow + i, 1) = "" Then 
       Exit For 
      End If 
      With xlSheet.Range(xlSheet.Cells(intStartRow + i, 1), _ 
           xlSheet.Cells(intStartRow + i, intColumnCount)).Interior 
       .Pattern = xlSolid 
       .PatternColorIndex = xlAutomatic 
       .Color = RGB(186, 186, 186) 
       .TintAndShade = 0.6 
       .PatternTintAndShade = 0 
      End With 

     Next i  'Next Row 

    Next   'Next Table 

    .Sheets("sheet1").Delete 
    .Sheets(1).Select   'Go to first sheet of workbook 

End With 

Export_to_Excel_Exit: 

rst1.Close 
rst2.Close 
rst3.Close 

xlApp.ActiveWorkbook.Save 
xlBook.Close 
If xlRunning Then   'Check to see if used an existing instance of Excel via SmartGetObject 
Else 
    xlApp.Quit 
    Set xlApp = Nothing 
End If 
Set xlBook = Nothing 
Set rst1 = Nothing 
Set rst2 = Nothing 
Set rst3 = Nothing 

Set dbs = Nothing 

Exit Sub