[三流君] −−> [VBAで楽しく] −−> [バックナンバー一覧]
−−> No.138 AccessからExcel出力、色・列幅・行の高さを調整する

AccessからExcel出力、色・列幅・行の高さを調整する

メルマガ発行内容

<AccessからExcel出力、色・列幅・行の高さを調整する>

こんにちは、三流プログラマーのKen3です。 郵便番号データの集計処理もいよいよ終盤戦です。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba138.lzh にdb138.mdb(Access2000版)が保存されています。 ※クエリーやデータをいじって、遊んでみてください。 Access から Excel 連携 http://www.ken3.org/cgi-bin/group/vba_access_excel.asp も参考にしてください。

/* * 1. 今回のキッカケ */

前回、までで、なんとか、出力用のデータをそろえられました。 ※ここまでに、かなり時間がかかりましたが。 今回は、 AccessからExcelへ出力時に、 セルに色を付けたり、列幅・行の高さを設定してみたいと思います。

/* * 2.Excelのマクロ記録で機能を探る */

セルに色を付ける、 列幅・行の高さを設定 そんな感じで、Excelのオブジェクトを操作したいので、 探り方としては、Excelのマクロ自動記録の機能を使用して探ってみます。 [No.2 AccessからExcel出力] http://www.ken3.org/backno/backno_vba01.html#2 で、 ・ウィザードを使ってたサンプルを作れることを説明 ・マクロ記録でExcelの操作をVBAにする ・頭にオブジェクト変数を付けてAccessからExcelを操作 を書いているので、参考にしてみてください。 色の変更、列幅の変更、行の高さの変更 この操作をマクロ記録してみます。 ↑行った操作 記録で作られたマクロは、こんな感じです。
Sub Macro1()

    Range("A1:A3").Select
    With Selection.Interior
        .ColorIndex = 5
        .Pattern = xlSolid
    End With
    Range("B1:B3").Select
    With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
    Columns("A:A").Select
    Selection.ColumnWidth = 8
    Columns("B:B").Select
    Selection.ColumnWidth = 6
    Rows("2:4").Select
    Selection.RowHeight = 16

End Sub
セルの色は、 ^^^^^^^^^^^^ .Interior.ColorIndex = 5 .Interior.ColorIndex = 6 など、で設定可能なので、事前に色の番号をマクロ記録で調べてもいいし、 RGBなどで、作ってもOKかなぁ。 列幅は、 ^^^^^^^^ Columns("A:A").Select で列選択、 Selection.ColumnWidth = 8 で、幅を設定。 ※選択処理しないで、直接設定も可能です。 行の高さは、 ^^^^^^^^^^ Rows("2:4").Select で、行選択、 Selection.RowHeight = 16 で、行の高さを設定 あとの詳細は、ヘルプを見る。 そんな感じで探れそうです。

/* * 3.Excelの出力処理に組み込む */

[No.131 Access クエリーをExcelシートへ罫線を付けて出力する] http://www.ken3.org/backno/backno_vba27.html#131 罫線付で、データをExcelへ出力してみました。 この処理に、 今回調べた、色を付ける処理、列幅、行の高さ、3つの機能を追加してみます。 まず列幅から、処理していきたいと思います。 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ (1) (2) (3) (4) (5) (6) (7) (8) (9) n行目 A列 B列 C列 D列 E列 F列 G列 H列 I列 001行 郵便番号 件数 空白 郵便番号 件数 空白 郵便番号 件数 空白 002行 107-52 27 160-23 27 193-33 27 003行 112-02 27 列の幅は、A列は10、B列は15など幅は縦に設定するので シートを作成したときに設定してみます。 郵便番号と件数の列を8.5、空白列を1.8に設定します。 For文で、3列単位で回してみました。 '列幅は、縦なので、ここ、頭で定義する For nXLINE = 1 To 9 Step 3 objEXCEL.Columns(nXLINE).ColumnWidth = 8.5 objEXCEL.Columns(nXLINE + 1).ColumnWidth = 8.5 objEXCEL.Columns(nXLINE + 2).ColumnWidth = 1.8 Next nXLINE こんな感じで、3列単位に、列幅を設定しました。 次は、行の高さです ^^^^^^^^^^^^^^^^^^ 行の高さは、見出しの文字列、罫線を引いた後にセットしてみたと思います。 見出しの高さを25、データの高さを16に設定します。 '行の高さを調整する objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '10行分の範囲文字列 objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ nYLINEが行カウンタなので、 Rows(nYLINE)で見出しの位置指定、 .RowHeight = 25で行の高さをセットしました。 nYLINEが1だとするとRows(1).RowHeight = 25としてます。 ~~~~~~~~~~~~~~~~~~~~ 次がデータ行です。 Rows("2:4").Select で、2〜4行選択、だったので、 :コロンで区切った文字列を作成して、指定します。 見出しの次の行から指定なので、 strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '10行分の範囲文字列 と 10行分の範囲 2:11を作成して、 Rows(strWORK)で範囲を指定、 .RowHeight = 16で高さのプロパティを16になする。 最後が、セルの色付けです。 ^^^^^^^^^^^^^^^^^^^^^^^^^^ セットのタイミングは簡単で、 セルにデータをセットした後に、背景色のプロパティを変更します。 'データをセットする(Accessから転記) objEXCEL.Cells(nYLINE, nXLINE) = rs("変換後郵便番号").Value objEXCEL.Cells(nYLINE, nXLINE + 1) = rs("変換後郵便番号のカウント").Value 'セルの色を変える objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = 33 'スカイブルー objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = 33 セルにマクロ記録で調べたカラーインデックスの33をセットしてます。 ↑実行結果です、なんとかここまでできました。 部分的に考えると、なんとかなりそうですね。 組み込んだ、長いセットのソースは、下記のような感じです。
Private Sub btnMakeExcel_Click()
    Dim rs As New ADODB.Recordset  'ADOのレコードセット
    Dim objEXCEL As Object  'Excel参照用
    Dim nYLINE   As Integer '行セット位置
    Dim nXLINE   As Integer '列セット位置
    Dim nRCNT    As Integer 'レコードカウンタ
    Dim strWORK  As String  'ワーク変数

    'Excelを起動する、オブジェクトの作成
    Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
    objEXCEL.Visible = True  'Excelを見えるようにする
    
    '新規のブックを追加する
    objEXCEL.Workbooks.Add   'Excelのブックを作成

    'Excelのシートを追加、シート名を変更する
    objEXCEL.Sheets.Add  'シートを追加する
    objEXCEL.ActiveSheet.Name = "DATA"  'シート名をDATAにする
    
    '列幅は、縦なので、ここ、頭で定義する
    For nXLINE = 1 To 9 Step 3
        objEXCEL.Columns(nXLINE).ColumnWidth = 8.5
        objEXCEL.Columns(nXLINE + 1).ColumnWidth = 8.5
        objEXCEL.Columns(nXLINE + 2).ColumnWidth = 1.8
    Next nXLINE

    'レコードセットを開く(Q_YUBIN_5)
    rs.Open "Q_YUBIN5", CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic

    'カウンタの初期化 スタート位置のセット
    nYLINE = 1 '1行目だよ
    nXLINE = 1 '1列目(A列)だよ
    
    '見出しをセットする
    objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
    objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
    '罫線を引く(見出しの位置から+10行分)
    Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                    objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
    '行の高さを調整する
    objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
    strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '10行分の範囲文字列
    objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ

    nYLINE = nYLINE + 1 '見出し分行数が増えます
    nRCNT = 1  '見出し表示後は1レコード目だよ
    
    'レコードセットからExcelへデータをセットする
    'ループ処理
    While rs.EOF = False  'いつものEOFが偽の間
        'データをセットする(Accessから転記)
        objEXCEL.Cells(nYLINE, nXLINE) = rs("変換後郵便番号").Value
        objEXCEL.Cells(nYLINE, nXLINE + 1) = rs("変換後郵便番号のカウント").Value
        'セルの色を変える
        objEXCEL.Cells(nYLINE, nXLINE).Interior.ColorIndex = 33 'スカイブルー
        objEXCEL.Cells(nYLINE, nXLINE + 1).Interior.ColorIndex = 33
        '次を読む And カウンタを移動する
        rs.MoveNext  '次のレコードに移動しないと、とんでもないことに(笑)
        nRCNT = nRCNT + 1   '処理レコード数を増やす
        If nRCNT > 10 Then  '処理したレコードが10を越えた(次の列)
            nXLINE = nXLINE + 3  '次の列へカウンタを移動
            If nXLINE > 9 Then '列が越えた?
                nXLINE = 1  '1列目(A列)に戻す
                nYLINE = nYLINE + 2  '空白行にしたいのでセット位置を+2する
            Else
                nYLINE = nYLINE - 10 '列が変わったので行カウンタをマイナスする
            End If
            
            '見出しの表示
            objEXCEL.Cells(nYLINE, nXLINE) = "郵便番号"
            objEXCEL.Cells(nYLINE, nXLINE + 1) = "件数"
            '罫線を引く(見出しの位置から+10行分)
            Call make_Border(objEXCEL.Range(objEXCEL.Cells(nYLINE, nXLINE), _
                                      objEXCEL.Cells(nYLINE + 10, nXLINE + 1)))
            '行の高さを調整する
            objEXCEL.Rows(nYLINE).RowHeight = 25 '見出しの高さを25へ
            strWORK = Trim(nYLINE + 1) & ":" & Trim(nYLINE + 10) '範囲文字列を作成
            objEXCEL.Rows(strWORK).RowHeight = 16 'データ高さを16へ
            
            nYLINE = nYLINE + 1 '見出し表示分行数が増えます
            nRCNT = 1  '見出し表示後は1レコード目だよ
        Else  '
            nYLINE = nYLINE + 1  '次の行へセット位置を移動
        End If
    Wend
    '通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き

    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

End Sub
'Rangeのエリアを受け取り、罫線を引く
Private Sub make_Border(objXY As Object)

    '罫線用のExcel定数(参照設定している場合は、必要無し)
    Const xlEdgeLeft = &H7
    Const xlEdgeRight = &HA
    Const xlEdgeTop = &H8
    Const xlEdgeBottom = &H9
    Const xlInsideVertical = &HB
    Const xlInsideHorizontal = &HC

    Const xlContinuous = &H1
    Const xlThin = &H2
    Const xlAutomatic = &HFFFFEFF7

    Dim n As Integer

    '配列に代入する
    Dim styleBOX As Variant
    styleBOX = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop _
                  , xlEdgeBottom, xlInsideVertical, xlInsideHorizontal)

    For n = 0 To 5 '各ラインに対して、値をセットする
        With objXY.Borders(styleBOX(n))
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    Next n

End Sub

/* * 4.終わりの挨拶 */

今回は、 AccessからExcelへの出力で、 列幅の変更、行の高さの変更、セルの背景色の変更 をやりました。 今回の、サンプルファイルは、 http://www.ken3.org/vba/lzh/vba138.lzh にdb138.mdb(Access2000版)が保存されています。 ※クエリーやデータをいじって、遊んでみてください。 あとは、連続してデータをセットですね。 う〜ん、まだまだだなぁ・・・ 何かの参考となれば幸いです。 Excel/Access大好き、三流プログラマーKen3でした。


ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか?少々心配しつつ、、、

種類別のリンク や 広告など

気になったジャンル↓を選択してください。

人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記3つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係 関数、その他]・・・その他Excel関係です

Access関係:
[Access UserForm/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です

その他:VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます

開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う]

仕様書(設計書?) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力]

※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。
※※読んで、気分を悪くされたらスミマセン。

Blogとリンク:[三流君の作業日記]/ [VBAやASPのサンプルコード]/ 広告-[通販人気商品の足跡]



[三流君(TOP ken3.org へ戻る)] / [VBA系TOPへ] / [VBA系バックナンバー目次へ移動]