Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Professional : Access 2016)
読み込んだデータにより背景色の変更
投稿日時: 18/07/18 07:51:00
投稿者: hareru

SQL DBより導出したデータをEXCELに出力しています。
出力は出来ているのですが、読み込んだデータ値により背景色を変更しようとしているのですが出来ず、コードが素通りされているような感じです。(DebugするとIF文の中には入って来ていて実行されています)
以下の★印箇所で背景色を変更しています。
何か良いアドバイスを頂けないでしょうか。
説明不足な点がありましてらご指摘ください。
    Set rst1 = New ADODB.Recordset
    rst1.Open pStrSql, ACcnn, adOpenForwardOnly, adLockReadOnly
    If rst1.EOF = False Then
         
        Dim xlApp As Excel.Application
        Dim wkb As Excel.Workbook
        Dim wks As Excel.Worksheet
     
        iSTAT = 14
         
        On Error Resume Next
        Set xlApp = GetObject(, "Excel.Application") '起動済Excelの取得
        If Err.Number <> 0 Then
            Err.Clear
             '起動済Excelが無い時新規作成
           Set xlApp = CreateObject("Excel.Application")
        End If
        Set wkb = xlApp.Workbooks.Add
        Set wks = wkb.Worksheets(1)
         
        iSTAT = 15
         
        Dim vntList As Variant
        Dim vntREC As Variant
        Dim lGyo As Long
        Dim lRetu As Long
         
        xlApp.ScreenUpdating = False
        xlApp.DisplayAlerts = False
     
        wkb.Sheets("Sheet1").Select
        With wks.Range("A1")
            For iIX1 = 1 To rst1.Fields.Count - 1 '2列目より取得
                 
                .Offset(, iIX1 - 1).Value = rst1.Fields(iIX1).Name
                 
                '項目左列1件目=No/iIX1=0
                If (iIX1 >= 2 And iIX1 <= 9) Or (iIX1 >= 14 And iIX1 <= 22) Then
                    xlApp.Columns(iIX1 + 1).Select
                    xlApp.Selection.NumberFormatLocal = "@"
                End If
             
            Next iIX1
 
            Let vntList = rst1.GetRows
            ReDim vntREC(UBound(vntList, 2), UBound(vntList, 1))
            For lGyo = LBound(vntREC, 1) To UBound(vntREC, 1)
                For lRetu = LBound(vntREC, 2) To UBound(vntREC, 2)
                    If lRetu > 0 Then
                        vntREC(lGyo, lRetu - 1) = vntList(lRetu, lGyo) '2列目より取得
                    End If
                Next
             
'★背景色の変更
                If vntREC(lGyo, 24) <> 0 Then
                    wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.ColorIndex = 3
                    wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.Color = RGB(217, 217, 217) End If
                           
            Next
             
            iSTAT = 16
             
            With wks
                .Range("A2").Resize(lGyo, lRetu).Value = vntREC
 
                '/// 1行目 ////////////////////////////////////////////////////////
                .Rows("1").Insert
                 
                .Range("Y1").Value = "集計差"
                .Range("Z1").Value = "取引先情報(1)"
                 
                '/// 2行目 ////////////////////////////////////////////////////////
                .Range("A2").Value = "No."
                .Range("B2").Value = "LV"
 
                .Range("A1:L1").Merge '基準
                .Range("A1:L1").Interior.ColorIndex = 3 'カラーパレット
                .Range("A1:L1").Interior.Color = RGB(255, 255, 153) 'haikeisyoku_yellow
          
                .Range("M1:X1").Merge '対象
                .Range("M1:X1").Interior.ColorIndex = 3 'カラーパレット
                .Range("M1:X1").Interior.Color = RGB(184, 204, 227) 'haikeisyoku_blue
 
                '/// 2行目 ////////////////////////////////////////////////////////
                '中央寄せ
                .Range("G:G").HorizontalAlignment = xlCenter '基準 正規/代替
                .Range("S:S").HorizontalAlignment = xlCenter '対象 正規/代替
 
                .Range("Y1:Y2").WrapText = True '折り返して表示 (員数累計差)
                Rows("1").RowHeight = 11.25 '折り返し後、自動で行高が変更されるので戻す。
             
                'AutoFit文を最後にしないと正常に設定されない
                .Columns("A:C").EntireColumn.AutoFit
                .Columns("F:G").EntireColumn.AutoFit
 
            End With
            
        End With
         
        '格子を全てOFFし、再設定。
        wks.Cells.Borders.LineStyle = False
        With wks.UsedRange
            .Borders.LineStyle = xlContinuous ' True
        End With
         
        'ウィンドウ枠の固定
        wks.Range("A3").Select
        xlApp.ActiveWindow.FreezePanes = True
         
        xlApp.Visible = True 'Excelを表示(「xlApp.Visible = False」をコーディングしなくとも入れないと表示しない時がある)
        wkb.Worksheets(1).Activate
        wks.Range("A1").Activate
         
    Else
         
        Set wks = Nothing
         
        rst1.Close: Set rst1 = Nothing
        MsgBox "data not found(2)", vbExclamation, "excel"
        GoTo EXCEL_EXPT_END
     
    End If

回答
投稿日時: 18/07/18 09:28:43
投稿者: Suzu

引用:
コードが素通りされているような感じです。(DebugするとIF文の中には入って来ていて実行されています)

 
どこのIfでしょうか。
引用:
'★背景色の変更
If vntREC(lGyo, 24) <> 0 Then
     wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.ColorIndex = 3
     wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.Color = RGB(217, 217, 217)
End If

 
このIf の が True で
 
引用:
wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.ColorIndex = 3
     wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.Color = RGB(217, 217, 217)

が、実行されているという事?
 
それなのに、
引用:
素通りされているような感じ
とは??
シングルステップで、実行されているのを確認しているのではないのですか?
情報が 予測事項/確認事項が入り混じり、かつ、矛盾がありますよね。
 
きちんと、ブレイクポイントを設け、目的のコードが実行されているか確認すれば良いと思いますよ。

回答
投稿日時: 18/07/18 10:53:06
投稿者: hatena
投稿者のウェブサイトに移動

 Suzuさんの回答に付け加えて、
 
デバッグ中は、
 
       On Error Resume Next
 
は、コメントアウトしておきましょう。
エラーが出ても素通りしてしまいますので。
 
' On Error Resume Next

回答
投稿日時: 18/07/18 10:53:36
投稿者: sk

引用:
出力は出来ているのですが、読み込んだデータ値により
背景色を変更しようとしているのですが出来ず、コードが
素通りされているような感じです。
(DebugするとIF文の中には入って来ていて実行されています)

引用:
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application") '起動済Excelの取得
If Err.Number <> 0 Then
    Err.Clear
    '起動済Excelが無い時新規作成
    Set xlApp = CreateObject("Excel.Application")
End If

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application") '起動済Excelの取得
If Err.Number <> 0 Then
    Err.Clear
    On Error GoTo 0
    '起動済Excelが無い時新規作成
    Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
 
------------------------------------------------------------------
(エラー時処理の行を定義している場合は適宜書き換えること)
 
引用:
wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.ColorIndex = 3
wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.Color = RGB(217, 217, 217)

wks.Range(wks.Cells(lGyo, 1), wks.Cells(lGyo, 49)).Interior.ColorIndex = 3
wks.Range(wks.Cells(lGyo, 1), wks.Cells(lGyo, 49)).Interior.Color = RGB(217, 217, 217)

回答
投稿日時: 18/07/18 11:03:23
投稿者: sk

追記:

引用:
With wks

引用:
Rows("1").RowHeight = 11.25

.Rows("1").RowHeight = 11.25

回答
投稿日時: 18/07/18 12:01:58
投稿者: Suzu

デバックの際には、
・エラー処理はコメントアウトを行っておく。
・今回の様にオートメーションにて他アプリケーションと連携を取っている場合には
  そのアプリケーションは可視化しておく。
・怪しい部分は、シングルステップで実行
 
が必須です。
 
でも、今回は
 

引用:
For lGyo = LBound(vntREC, 1) To UBound(vntREC, 1)
                For lRetu = LBound(vntREC, 2) To UBound(vntREC, 2)
                    If lRetu > 0 Then
                        vntREC(lGyo, lRetu - 1) = vntList(lRetu, lGyo) '2列目より取得
                    End If
                Next
              
'★背景色の変更
                If vntREC(lGyo, 24) <> 0 Then
                    wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.ColorIndex = 3
                    wks.Range(Cells(lGyo, 1), Cells(lGyo, 49)).Interior.Color = RGB(217, 217, 217) End If

 
この部分でエラーが出ます。
 
「インデックスが有効範囲にありません」
 
カーソルを、各変数の上に移動させると、その変数の中身が確認できます。
エラーが出た時の lGyo 「0」でした。 Cellsは、1からの数字しかとりませんので、
その部分でインデックス範囲が有効範囲にありません と出ています。
 
hatenaさん、skさん がご指摘くださっている
On Error Resume Next
が有効なため、エラーを無視して次に進んでいたので 問題に気付かなかったのでしょう。
 
どうすればよいかは。。。なにをどう判定し、その結果どうしたいのかが判らないので。。
なんとも言えません。。
 
何となく。。
wks.Range(Cells(lGyo, 1), Cells(lGyo, 49))

wks.Range(Cells(lGyo+1, 1), Cells(lGyo+1, 49))
 
かもね。。程度の予測くらいです。
(もちろん、その変更で動作が変わりますのでエラーにならなかったからOkではなく、
  遣りたい事が条件どうり実施されているか確認しましょう)

投稿日時: 18/07/19 12:46:58
投稿者: hareru

みなさん、回答ありがとうございます。
 
"On Error 〜"を記述したら、背景色が変更されるようになりました!?。
エラー処理については全く、気が付きませんでした。
 
結局、下記のように変更し、想定した事が可能となりました。
 
      '★背景色の変更
        If vntREC(lGyo, 24) <> 0 Then
          wks.Range(wks.Cells(lGyo + 2, 1), wks.Cells(lGyo + 2, 50)).Interior.ColorIndex = 3 'カラーパレット
          wks.Range(wks.Cells(lGyo + 2, 1), wks.Cells(lGyo + 2, 50)).Interior.Color = RGB(217, 217, 217) 'haikeisyoku_orange
       End If
ありがとうございました。