xls:CopyFromRecordset罫線描写

質問

こんにちは。
お世話になります。

エクセルからアクセスを読み込みに行き、取得結果をエクセル内に表示しています。
※アクセスを開いてエクセルに出力するのではないです。

このとき、スタートセルを指定して
Range("B12").CopyFromRecordset adoRs
という感じで読み取ったデータを出力していますが、

この出力前に明細にしている部分を消しています。
Range("B12:AI1000").Clear '前のデータクリア
※ClearContentsではダメな理由があります。

このとき、CopyFromRecordset にて出力が行われたセルのみ、
セルのまわりを四角く罫線で囲むということをしたいです。
明細っぽくしたいので。

罫線はこのように引くと思うのですが
Range("A1:C3").Borders.LineStyle = xlContinuous
このA1:C3の部分を今回B12から始まり、列はAIまで、
行数は条件により変動するため固定ではない状態で、
どのようにすれば取得できるのかが知りたいです。

よろしくお願いいたします。

office2010、windows7です。

回答No.5

cj_mover · ベストアンサー

＃１-４、ｃｊです。＃４、お礼欄へのレスです。

余計なことかも知れませんが、、、。
> 数日以内にお返事頂けない場合はそのままベストアンサーとして締め切らせて頂きます。
「よりベターな解決」を導くことを目指しているつもりではありますが、
残念ながら今回は「ベスト」に値することは出来ていない、というのが自己評価で、
「ベストアンサーを決めずに質問を締め切る」ぐらいが、私見としては妥当な気もしています。
回答者としては、「どんな形であれ「解決した」と報せて頂けること」が何よりこの上ないご褒美と考えています。
解決の目途が立ったということでしたらば、それと解る様に質問をCloseするのはマナーとしても大切なことですし、
お礼という意味で評価を頂けるなら、なおさら有難いことです。
（そもそも回答者が判断することではありませんし、どんな結果であってもただ素直に受け止めるだけですが）
ただ、締切前に言及されると、なんとなく返事を書き難いですね。ちょっと躊躇ってしまいました。

> 実は．．．．．．ちょっとダウンしていまして
その後お加減は如何ですか？お大事になさってください。
遅れる旨きちんと伝えようという誠実さは私としては好印象なのですが、
コンディションに関わることは、お互い様だったり（相手の方が大変だったり）する場合も多いので、
なるべく触れない方がベターと思います。（これは私の反省でもあります。）
エクスキューズしたい時は「今は余裕がないので後ほど」ぐらいで十分かも、です。
また、返事が遅れることを気にする必要もありません。
皆、（こちらも、）事情を抱えている中で、出来る時にしか出来ないです。
以上、老婆心ながら。

本題、

> With Range("B12")
> .Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 24).Borders.LineStyle = xlContinuous
> End With

お求めなのは、上記３行の解説、という理解でいますので、その部分だけについてお応えします。

まず確認しておきますが、これらの記述は、ADODBとは全く無関係、スタンドアローンなExcelのお話です。

とりあえず、解り易さの為（却って読み難いですが）、Withフレーズを外して、１行に書き直すと以下のようになります。
　　Range("B12").Resize(Range("B12").End(xlDown).Row - Range("B12").Row + 1, Range("B12").End(xlToRight).Column - Range("B12").Column + 24).Borders.LineStyle = xlContinuous

内容としては、
●　採り込んだデータ範囲に罫線を引く。
●●１）Range("B12")を基準に、必要な行数、必要な列数でセル範囲を指定する。
●●●　.Resizeプロパティ【書式：Range().Resize(RowSize, ColumnSize)】で、
　　　　Range("B12")を（左上のセルとして）基準に、必要な行数、必要な列数でセル範囲の大きさを指定する。
　　　　※.Resizeプロパティ については、VBAのヘルプを引いて確認してください。
●●●●ｒ）行サイズ指定
　　　　　　Range("B12").End(xlDown).Row　で「行方向に連続したデータの最下行」の絶対的な行位置を数値で採り、
　　　　　　Range("B12").Row　で、基準となるセルの行位置（この場合は12）を採り、必要な行数を計算する。
　　　　　　例えば、レコード数が１０である場合は、
　　　　　　　Range("B12").End(xlDown).Row　は、２１
　　　　　　　Range("B12").Row　は、１２
　　　　　　　Range("B12").End(xlDown).Row - Range("B12").Row は　２１ - １２ = ９　となるので、
　　　　　　　+ １　を加えて、１０にする。
　　　　　　といった具合です。
　　　　　　　Range("B12").End(xlDown).Row - 11
　　　　　　のように、"B12"を決め打ちにして書いても求まりますが、
　　　　　　　With Range("B12")
　　　　　　　　.Resize(.End(xlDown).Row - .Row + 1,　......
　　　　　　　End With
　　　　　　のようにWithフレーズを用いることで、基準となるRange("B12")を変更する必要が出てきても、
　　　　　　１カ所（"B12"を）書換えるだけで（必要な行数指定に）対応できるように書いています。
　　　　　※.Endプロパティ については、VBAのヘルプを引いて確認してください。
　　　　　　Range("B12").End(xlDown)　のxlDownの意味についてですが、
　　　　　　基準となるセル（Range("B12")）から下方向に、最初に見つかる空セルのひとつ上のセル、を
　　　　　　レコードの終端として取得します。
　　　　　　もしも、間に空セル（データベースでいう所のNull）があると、正しく機能しませんが、
　　　　　　１列目（第１フィールド）にNull値、というのは普通はあり得ないでしょうから、この方法を採っています。
　　　　　　一般的なExcelの手法としては、
　　　　　　　With Range("B12")
　　　　　　　　.Resize(Cells(Rows.Count, .Column).End(xlUp).Row - .Row + 1,　......
　　　　　　　End With
　　　　　　とか、
　　　　　　　With Range("B12")
　　　　　　　　.Resize(Cells(10001, .Column).End(xlUp).Row - .Row + 1,　......
　　　　　　　End With
　　　　　　などのように、下から上方向に探して、レコードの終端として取得する方法もあります。
●●●●ｃ）列サイズ指定
　　　　　　Range("B12").End(xlToRight).Column　で「列方向に連続したフィールドの最右列」の絶対的な列位置を数値で採り、
　　　　　　Range("B12").Column　で、基準となる列位置（この場合は12）を採り、必要な列数を計算する。
　　　　　　という意図で書かれたものでしたが、この方法では、Null値があると不正な結果になってしまいますね。
　　　　　　フィールド数は固定？という話のようですから、この部分は、直値で指定してあげればいいです。（修正■）
●●２）.Borders.LineStyle = xlContinuous　で、罫線を引く。
　　　　この部分は説明不要と思います。
解説としては以上のようになります。

列数は固定でいい？ようなので、それを踏まえると
　　With Range("B12")
　　　　.Resize(.End(xlDown).Row - .Row + 1, 24).Borders.LineStyle = xlContinuous
　　End With
のように修正■されます。
後は、.Endプロパティ の使い方として、下から上方向に探す必要がある場合などは、
実用上のニーズに照らして応用してみてください。

拙い説明ですが、以上です。

お礼

落ち着いて読み直し、
各プロパティの細かい文法はまだですが、
それ以外の記述方法については
すべて理解できました。

このたびは大変ご親切に、そしてご丁寧に
ありがとうございました。

補足

こんにちは。

躊躇わせてしまう結果になりすみません。

はい、もう解決することができましたので
マナーとして近日中に締め切る予定です。
さらに、迅速な回答を頂き、さらに質問する際のお作法も
ご教示いただき、大変満足していますので、
ベストアンサーは送らせて頂きます！
ご了承ください。

その上で、最後に追加の質問をさせて頂いているため
質問したまま締め切る形になるとそれも失礼かと思い
断らせて頂きました。

なんにせよ、答えづらい展開になってしまったようで
ごめんなさい。

コンディションの件、はい、復調してきました。
ありがとうございます。
言及しない方がよい旨、理解しました。
そうですね、返事が遅れますくらいにしておきます。

まずは本題前の部分について、返信させて頂きました。

ありがとうございました。

本題の理解はじっくり読み込ませて頂き、
そののちにお礼欄にてご連絡させて頂きます。

回答No.6

cj_mover

＃１-５、ｃｊです。＃４補足欄へのレスです。
> すみません、一つだけうまくいかないケースがありました。

> 出力するレコードが1レコードだけのときです。

> その場合だけは、エクセル内の一番下の行まで全部
> 罫線が引かれてしまいました。

> 原因おわかりになりますでしょうか。

"レコードが1レコードだけのとき”への対策としては、
＃５で示した.End(xlDown)を応用して、下から上へ探すように応用しておけばいいです。
　　With Range("B12")
　　　　.Resize(Cells(Rows.Count, .Column).End(xlUp).Row - .Row + 1, 24).Borders.LineStyle = xlContinuous
　　End With
とか、
　　With Range("B12")
　　　　.Resize(Cells(10001, .Column).End(xlUp).Row - .Row + 1, 24).Borders.LineStyle = xlContinuous
　　End With
とかになります。
レコード最下行の取得方法についてどちらを選ぶか、は、そちらのExcelシートのレイアウト次第ですが、
Excelに用意された最下行（65536または1048576）から上に探すか、
10001行めから上に探すか、の違いです。

お礼

うまくいきました！
ありがとうございました。

補足

ちなみに、出力がゼロの場合、
つまり検索対象のレコードがなかった場合に
この罫線を引く部分でエラーになりましたので
カウンタをつけて、カウンタがゼロ以上のときのみ

このwithプロパティを機能させるようにしました。

特別お知らせする内容でもないですが、一応。

回答No.4

cj_mover

あ、すみません。
＃１-３、ｃｊです。＃２補足欄へのレス、追記です。

直接の回答、候補１）の場合は、
＃２補足欄でご提示の(1)の部分に
　　adoRs.CursorLocation = 3　　'　　adUseClient
を追加してください。
（　候補２）の場合は不要です。）
失礼しました。

お礼

記述してみました。

出来ました。
（２）の方でやりました。

実は例示した内容から少し変更を加えました。
しかしできました。

adoRs.Open strSQL, adoCn 'SQLを実行して対象をRecordSetへ
Range("B12:AI1000").ClearContents '前のデータクリア
Range("B12:AI1000").Font.ColorIndex = xlAutomatic 'フォント色を初期化
Range("B12:AI1000").Borders.LineStyle = xlLineStyleNone

Application.EnableEvents = False 'イベントオフ(ワークシートチェンジが反応しないように)
i = 12 'スタート行
Do Until adoRs.EOF 'レコードセットが終了するまで処理を繰り返す
Cells(i, 2) = adoRs!ID
Cells(i, 3) = adoRs!item_no
Cells(i, 4) = adoRs!color_no
Cells(i, 5) = adoRs!item_name
Cells(i, 6) = adoRs!FREE
Cells(i, 7) = adoRs![3m]
Cells(i, 8) = adoRs![6m]
Cells(i, 9) = adoRs![50_0-1m]
Cells(i, 10) = adoRs![56_1-2m]
Cells(i, 11) = adoRs![62_2-4m]
Cells(i, 12) = adoRs![68_4-6m]
Cells(i, 13) = adoRs![74_6-9m]
Cells(i, 14) = adoRs![80_12m]
Cells(i, 15) = adoRs![86_18m]
Cells(i, 16) = adoRs![92_2y]
Cells(i, 17) = adoRs![98_3y]
Cells(i, 18) = adoRs![10_4y]
Cells(i, 19) = adoRs![110_5y]
Cells(i, 20) = adoRs![116_6y]
Cells(i, 21) = adoRs![122_7y]
Cells(i, 21) = adoRs![128_8y]
Cells(i, 21) = adoRs![134_9y]
Cells(i, 21) = adoRs![140_10y]
Cells(i, 21) = adoRs![152_12y]
Cells(i, 21) = adoRs![164_14y]
i = i + 1 '行をカウントアップする
adoRs.MoveNext '次のレコードに移動する
Loop

With Range("B12")
.Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 24).Borders.LineStyle = xlContinuous
End With

'adoRs.MoveLast
' Range("B12").Resize(adoRs.RecordCount, adoRs.Fields.Count).Borders.LineStyle = xlContinuous

Application.EnableEvents = True 'イベントオン

'Application.EnableEvents = False 'イベントオフ(ワークシートチェンジが反応しないように)
' Range("B12").CopyFromRecordset adoRs 'セルへ出力
' Range("F10:F26").NumberFormatLocal = "yyyy/m/d h:mm;@" '書式設定

'Application.EnableEvents = True 'イベントオン

縦は一発でうまくいき、横にどこまで罫線を引くセルを増やすか、は実際に数字を変えていって答えを得ました。
今回は+24にしました。

このあたり、もしよかったら記述している内容の読み方を教えて頂けますでしょうか。おまじないに数字の増減をしただけより、もう少しだけ内容を理解したいと思いまして。

数日以内にお返事頂けない場合はそのままベストアンサーとして締め切らせて頂きます。

本当にありがとうございました。

補足

すみません、一つだけうまくいかないケースがありました。

出力するレコードが1レコードだけのときです。

その場合だけは、エクセル内の一番下の行まで全部
罫線が引かれてしまいました。

原因おわかりになりますでしょうか。

回答No.3

cj_mover

＃１、２、ｃｊです。＃２補足欄へのレスです。

要するに、レコードセットの中身が、どのように開かれて
どのように読み込まれているか、その状態によって、
adoRs.RecordCountを正しく取得できるかどうかが決まってくる
という話でして、＃２で示したのは簡単な例として、
自己完結したサンプルプロシージャですので、
今回ご提示の記述に組み込むのは土台、無理なのです。
でもまぁ、ようやくソースを見ることが出来ましたから、
今回はオンデマンドでお応え出来るかと思います。

とりあえず、今までのことは一旦忘れてもらって、
罫線を引く部分だけ書き足すように

> Range("B12").CopyFromRecordset adoRs 'セルへ出力

の部分に続けて以下の２行を書き加えます。
候補１）
　　adoRs.MoveLast
　　Range("B12").Resize(adoRs.RecordCount, adoRs.Fields.Count).Borders.LineStyle = xlContinuous

レコード数をレコードセットに問うのではなくて、
Excelに吐き出されたサイズを取得するなら、
代りに、以下の３行を書き加えます。
候補２）
　　With Range("B12")
　　　　.Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 1).Borders.LineStyle = xlContinuous
　　End With

直接の回答は以上です。

>「ユーザー定義型は定義されていません。」と
> エラーになります。

ADODBを参照設定していないのでしたら当然の（コンパイル）エラーです。
Excel VBAからADODBを扱うのでしたら、
Microsoft ActiveX Data Objects#.# Library
に参照設定した方が、何かと扱い易いです。
１）
Dim adoRs As Object
の代りに、Object型ではなく、
Dim adoRs As ADODB.Recordset
ADODBで既定のオブジェクトとして宣言できる、とか、
２）
　　Set adoCn = CreateObject("ADODB.Connection")
の代りに、CreateObjectは使わずに、
Set adoCn = New ADODB.Connection
のように高速且つ明示的にアクセス出来るとか、
３）
　　adUseClient　adOpenDynamic　adLockOptimistic
みたいな、ADODBで定義された組込み定数が使えるようになるとか、
４）
　　adoRs.
までタイプした時点で入力候補が表示されるようになるとか、
色々と便利で能率的に書けるようになります。
配布の問題から配布時に参照設定を外すことはあるかも知れませんが、
開発の段階では参照設定した方が圧倒的に有利です。
疑問を感じて手が止まることも減るでしょうから、
開発を早める意味でも、不慣れな人程、利点は多いと思います。
逆に参照設定しないでADO書きあげちゃう人の方が凄いですし、少数派、と思います。

http://www.happy2-island.com/access/gogo03/capter00307.shtml
リンク先は旧いAccessについて解説していますが、
参照設定の手順（設定手順３以降）や解説は参考になるかと思います。

以上です。

お礼

ありがとうございました。

レコードセットの開き方、読み方によって
扱い方が違うことをご教示くださり
まずその部分で大変助かりました。

「レコードセットするときにはこの関数を使えば
セットするレコード数がわかります」
的な一意的な内容かと思っていました。

そして、適切なご回答をいただくためには
ソースの開示が重要ということも理解しました。
上記のような一意的だという理解だったため
ソース貼付は冗長になるかと誤認識していました。

直接のご回答ありがとうございます。
そしてそれ以降のマナーというか、お作法というか、
のご教示もありがとうございます。
今回ADODBという単語に初めて触れてまだ数日という
タイミングなのですが、そこでどういうものなのかを
多角的にご教示いただき、今後の参考にできます。

実はウィルス性腸炎か何かにかかったようで
ちょっとダウンしていまして、のちほど直接のご回答の
内容を試してみようと思います。

その後No.4の方にもお礼欄でご連絡させていただきます。

ありがとうございました。

回答No.2

cj_mover

＃１、ｃｊです。＃１、補足欄へのレスです。

問題は、どうやってレコードセットを開いているか、ですけれど、
カーソル位置を指定してやればいいだけなので、一例をあげておきます。
Win7 64　ビット・Excel2010 64ビット 環境で実際に動作確認しましたが、
他の環境では試していません。
ポイントの部分に■マークしておきました。
適宜応用してください。

Sub Re8375561()
　　Dim adoCn As ADODB.Connection
　　Dim adoRs As ADODB.Recordset
　　Dim sFile As String
　　Dim sTable As String

　　sFile = ThisWorkbook.Path & "\mjlk.mdb"　　'　 ファイル名（フルネーム）
　　sTable = "成績日報"　　'　 テーブル名

　　Set adoCn = New ADODB.Connection
　　adoCn.ConnectionString = _
　　　　"Provider=Microsoft.ACE.OLEDB.12.0;" & _
　　　　"Data Source=" & sFile
　　adoCn.Open

　　Set adoRs = New ADODB.Recordset
　　adoRs.Source = sTable　　'　 テーブル名
　　adoRs.ActiveConnection = adoCn
　　adoRs.CursorLocation = adUseClient　　' ■←ココ■
　　adoRs.CursorType = adOpenDynamic
　　adoRs.LockType = adLockOptimistic
　　adoRs.Open

　　With Range("B12")
　　　　.Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 1).Clear
　　　　.CopyFromRecordset adoRs
　　　　.Resize(adoRs.RecordCount, adoRs.Fields.Count).Borders.LineStyle = xlContinuous
' ' ↓　これでもOK
'　　　　.Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 1).Borders.LineStyle = xlContinuous
　　End With

　　adoRs.Close
　　adoCn.Close

　　Set adoCn = Nothing
　　Set adoRs = Nothing
End Sub

補足

こんにちは。

どうもありがとうございます。

以下が私のモジュールなのですが、この中の(1)・(2)に
それぞれいただいた記述をセットしてみましたが、
エラーになってしまいました。

Private adoCn As Object 'ADOコネクションオブジェクト
Private adoRs As Object 'ADOレコードセットオブジェクト
Private strSQL As String 'SQL文
Private Const DBpath As String = "C:\!在庫表\zaiko.accdb" '接続するファイル（2007～）のフルパス

Sub DBconnect(flg As Boolean) 'DB接続プロシージャ

Set adoCn = CreateObject("ADODB.Connection") 'ADOコネクションオブジェクトを作成

If flg = True Then Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクトを作成
'adoCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBpath & ";" 'Accessファイル（～2003）を開く
adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & ";" 'Accessファイル（2007～）を開く

End Sub

Sub DBread() '読み込み
Dim shouhinbangou As String, dy As String, txt As String

Call DBconnect(True) 'DB接続

With UserForm1
.Show 'ユーザーフォーム表示

If .TextBox1 = "" Then '商品番号欄が空欄の場合
shouhinbangou = ""
Else '商品番号欄が記入済
shouhinbangou = "WHERE item_no LIKE '%" & .TextBox1 & "%' " '～を含む
'shouhinbangou = "WHERE item_no='" & .TextBox1 & "' " '商品番号を指定
'shouhinbangou = "WHERE zaiko_table.item_no='" & .TextBox1 & "' " '商品番号を指定
End If
End With

'SQL文の作成
' strSQL = _
' "SELECT zaiko_table.ID, zaiko_table.item_no, zaiko_table.color_no, zaiko_table.item_name, zaiko_table.FREE " & _
' "FROM zaiko_table " & _
' " shouhinbangou " & _
' "ORDER BY zaiko_table.item_no ASC"

strSQL = _
"SELECT * " & _
"FROM zaiko_table " & _
shouhinbangou

(1)

adoRs.Open strSQL, adoCn 'SQLを実行して対象をRecordSetへ
Range("B12:AI1000").ClearContents '前のデータクリア
Range("B12:AI1000").Font.ColorIndex = xlAutomatic 'フォント色を初期化

Range("B12").CopyFromRecordset adoRs 'セルへ出力

(2)

Call DBcut_off(True) 'DB切断

End Sub

(1)にセットしても(2)にセットしても
「ユーザー定義型は定義されていません。」と
エラーになります。

組み込んだのは以下です。

Dim adoCn As ADODB.Connection
　　Dim adoRs As ADODB.Recordset
　　Dim sFile As String
　　Dim sTable As String

　　Set adoRs = New ADODB.Recordset
　　adoRs.Source = sTable　　'　 テーブル名
　　adoRs.ActiveConnection = adoCn
　　adoRs.CursorLocation = adUseClient　　' ■←ココ■
　　adoRs.CursorType = adOpenDynamic
　　adoRs.LockType = adLockOptimistic
　　adoRs.Open

　　With Range("B12")
　　　　.Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 1).Clear
　　　　.CopyFromRecordset adoRs
　　　　.Resize(adoRs.RecordCount, adoRs.Fields.Count).Borders.LineStyle = xlContinuous
' ' ↓　これでもOK
'　　　　.Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 1).Borders.LineStyle = xlContinuous
　　End With

VBAデビューしたばかりでアクセスにも初めて接続したため
AdoRsですとかADODBのあたりはまだおまじないにしか
見えておりません。
接続用のオブジェクトを生成して、そのオブジェクトが
定型的な接続用の関数を持っているのだな程度の理解でして
私のモジュールを頂いたご例示の表現に切り替えるのが
現状では難しいです。

もしよかったら私のモジュールに沿った形で再度
ご教示いただけますでしょうか？

回答No.1

cj_mover

こんにちは。
レコードセット、ならば、大きさがわかりますから、
Excel側のRangeを.Resizeするのが簡単かと。

　　Range("B12").Resize(adoRs.RecordCount + 1, adoRs.Fields.Count).Borders.LineStyle = xlContinuous

お礼

おはようございます。
大変お早いお返事、さらに補足欄へのご回答までありがとうございました！
二回目のご回答、本日のちほど早速試させていただきます。

補足

こんばんは。

早速ありがとうございます。

CopyFromRecordSetで出力した内容を取得することが
できるんですね！
それならとてもありがたいです。

ちなみにB12を出力データの左上のセルとしたときに、
横には必ず25列データが出力されます。
縦には検索条件によりますが今回は15レコード出力
されました。

このときに
Range("B12").Resize(adoRs.RecordCount + 1, adoRs.Fields.Count).Borders.LineStyle = xlContinuous
を記述したところ
アプリケーション定義またはオブジェクト定義のエラーです。
となりました。

msgboxで出力したところ、
adoRs.RecordCount　は　-1
adoRs.Fields.Count　は　25
でした。

adoRs.Fields.Countは問題ないようです。
adoRs.RecordCount + 1　は　0　なので
adoRs.RecordCount + 2　としたところ、
上記のエラーはでなくなりましたが、
最初の1レコードのみ罫線がセットされたのみでした。

何が起こっているのでしょうか？