ken3memo (三流君)

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
(※詳細は[三流君 三流プログラマーとは?]を見てください)




[記事一覧、バックナンバーを見る]

2011-02-09

XXXXXさんへ QA110203 2月3日 問い合わせ Excelの列幅の調整をAccessから?

下記のような質問をいただきました。

>早速で申し訳ありませんが、ACCESSからEXCELファイルを操作させる

>手法をご指導頂けないかと投稿させて頂きます。(前置きが長くすみません)

>EXCELファイルのブック全体に対して、列幅を調整できないかと悩んでおります。

>シートの数は、その時によって変化してしまうので、シートの指定ではできない

>と感じております。また、シート毎にA列の幅が異なるので、全てのシートを最大

>に設定すれば良いのですが、なるべく文字数の最大に設定したいと考えております。

>

>これらの要素をACCESSから操作することは可能でしょうか?

この質問に対して、分割してチャレンジしてみたいと思います。

ア.Accessから

イ.開いているExcelブックに対して

ウ.全てのシート(ブック全体)

エ.列幅の調整

を行いたい。

って感じかなぁ。

下からやってみます


全体の流れ/解説は http://ken3hitori.g.hatena.ne.jp/bbs/18?from=1 を見てください。

QA110203 調査1 エ.列幅の調整 エクセルで列幅の調整 を マクロ記録で探ってみる

エクセルで列幅の調整 を マクロ記録で探ってみました。

全ての列幅を自動調整するには

Cells.EntireColumn.AutoFit

で できました。

Option Explicit

Sub Macro1()
'
' Macro1 Macro
'

'指定した列幅を自動調整、ここではA-C Columns("A:C")を指定
    Sheets("Sheet2").Select
    Columns("A:C").EntireColumn.AutoFit
    Range("A2").Select
End Sub

Sub Macro2()
'
' Macro2 Macro
'

'シート全体(全ての列)の列幅を自動調整 Cellsで全てのセルを選択
    Sheets("Sheet2").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
End Sub

試行錯誤の動画

こんな感じで、マクロ記録で作ってみました。

D

http://www.youtube.com/watch?v=LhqF7SC3QrA

↑列幅の調整テストなので、

東京一郎 や 横浜太郎 だと味気ないので、

長い名前の人で有名人な人としてよく

ユースケ・サンタマリア さんを使っています。

※みなさんも、テストデータとして使ってみてください。

(業界のテストデータで流行るいいいなぁなんて)

テストデータ

金曜日 タイトル LADY〜最後の犯罪プロファイル〜(TBS系)

出演者 役名

北川景子 香月翔子役

木村多江 結城晶

平岡祐太 新堀圭祐役

須藤理彩 奥居マリエ役

小澤征悦 藤堂壮一郎役

要潤 寺田毅彦役

ユースケ・サンタマリア 柘植正樹役

月曜日 タイトル 大切なことはすべて君が教えてくれた

出演者 役名

戸田恵梨香 上村夏実役

三浦春馬 柏木修二役

武井咲 佐伯ひかり役

篠田麻里子 東堂さやか役

内田有紀 水谷亜弥役

西村雅彦 中西佳史役

風間杜夫 鶴岡悟司役

で、列幅の自動調整のテストをしてみました。


全体の解説は http://ken3hitori.g.hatena.ne.jp/bbs/18?from=1 を見てください。

QA110203 調査2 ウ.全てのシート に 対してマクロ VBAの処理を実行したい

ActiveWorkbook.Sheets.Count で シートの数

Activeworkbook.Sheets(n番目).Select で シートの選択(処理中シート、アクティブの切り替え)

取得・切り替え可能だったので、

単純に For の ループ で 1 から .Count番目まで処理を回してみました。

For n = 1 To ActiveWorkbook.Sheets.Count

Sheets(n).Select 'シートのn番目を選択

'シート単位で行いたい処理

'シート単位で行いたい処理

'シート単位で行いたい処理

Next

まぁ、こんな感じで作ってみました。

Sub Macro2()

'シートの数 ActiveWorkbook.Sheets.Count
'シートの選択 Activeworkbook.Sheets(番号でもOK).Select ※1から

    Dim n As Integer  'カウンター
    
    'シートの数だけループする
    For n = 1 To ActiveWorkbook.Sheets.Count
        Sheets(n).Select  'シートのn番目を選択
        Cells.EntireColumn.AutoFit  '列幅を自動調整
        Range("A1").Select  'カーソルをA1へ
    Next
    
End Sub

試行錯誤 イミディエイトで調べたり、デバッグしたり

いつものように ハマった動画は、下記のような感じです。

D

http://www.youtube.com/watch?v=wfhMeMIs8dU


全体の解説は http://ken3hitori.g.hatena.ne.jp/bbs/18?from=1 を見てください。

QA110203 調査 イ.開いているExcelブックを切り替え 処理を行う

マクロ記録で エクセル ブックの切り替えを調査する

シートの切り替えはできたので、

ブックの切り替えにチャレンジしてみる。

マクロ記録でブックの切り替えをチェックすると

Sub Macro3()
'
' Macro3 Macro
'

'
    Application.Left = -108.5
    Application.Top = 46
    
    Windows("TEST001.xls").Activate
    Sheets("Sheet3").Select
    
    Windows("TEST20110207.xlsm").Activate
    
    Application.Left = 32.5
    Application.Top = 46
End Sub

と記録されました。

ここから、

Windows("TEST001.xls").Activate

で、ブックが切り替わることを確認。

次に開かれているブックの数を知りたかったので、

イミディエイトのウインドウで

application.

と入力すると、.Windowsが見つかり、

その先にいつもの.Countを発見。

? Application.Windows.Count

でチェックすると、2が(2つブックを開いていたので)

Application.Windows.Count で ブックの数を知ることができました。

あとは、組み合わせで、ループさせてみました。

'開いているブックのすべてのシートに対して、自動列幅調整を行うテスト
Sub Macro2()

'ブックの数 Application.Windows.Count で
'切り替えは Windows(index番号).Activate で

'シートの数 ActiveWorkbook.Sheets.Count
'シートの選択 Activeworkbook.Sheets(番号でもOK).Select ※1から

    Dim b As Integer  'ブックのカウンター
    Dim n As Integer  'カウンター
    
    For b = 1 To Application.Windows.Count 'ウインドウ(ブック)の数ループ
        Windows(b).Activate  'b番目のブックをアクティブにする
        
        'シートの数だけループする
        For n = 1 To ActiveWorkbook.Sheets.Count
            Sheets(n).Select  'シートのn番目を選択
            Cells.EntireColumn.AutoFit  '列幅を自動調整
            Range("A1").Select  'カーソルをA1へ
        Next n
        
    Next b
    
End Sub

試行錯誤、マクロ記録からブックの切り替えを探る

試行錯誤の動画、マクロ記録から、WorkBookを切り替える命令(VBA)を探ってみました。

D

http://www.youtube.com/watch?v=wucvPMmq4Is

↑こんな感じで、途中 固まりながら 探ってます。

予定外のエラー で 固まりまくりの 三流君を笑ってください(笑)


全体の解説は http://ken3hitori.g.hatena.ne.jp/bbs/18?from=1 を見てください。

QA110203 番外編 テストデータ作り ExcelのデータをAccessへコピペする

テーブルフォーマット

テストデータを渡された

ので、

テスト(と言っても ほとんど本番環境だけど)を作ります。

テーブルは2つ

ア.ドラマのタイトル保存用

Tタイトル

ID AUTONO

ドラマタイトル CHAR(50)

イ.出演者

T出演者

ドラマID INT

出演者 CHAR(20)

役名 CHAR(20)

テーブルのイメージ図

f:id:ken3memo:20110209072418j:image

テストデータ

金曜日 タイトル LADY〜最後の犯罪プロファイル〜(TBS系)

出演者 役名

北川景子 香月翔子役

木村多江 結城晶

平岡祐太 新堀圭祐役

須藤理彩 奥居マリエ役

小澤征悦 藤堂壮一郎役

要潤 寺田毅彦役

ユースケ・サンタマリア 柘植正樹役

月曜日 タイトル 大切なことはすべて君が教えてくれた

出演者 役名

戸田恵梨香 上村夏実役

三浦春馬 柏木修二役

武井咲 佐伯ひかり役

篠田麻里子 東堂さやか役

内田有紀 水谷亜弥役

西村雅彦 中西佳史役

風間杜夫 鶴岡悟司役

↓こんな感じでExcelでコピー 後 Accessで貼りつけ(ペースト)してみました。

D

http://www.youtube.com/watch?v=2-t57-38K38


テストデータを使った、全体の解説は http://ken3hitori.g.hatena.ne.jp/bbs/18?from=1 を見てください。

QA110203 ア.AccessのクエリーをExcelに書き出す 転記する

AccessからExcelを起動して、

新規のブック、シートに データを(クエリーの中身を)書き込みます。

ADOでクエリーを読み込み、Excelへ単純に書き出す

クエリーからエクセルへデータを転記します。

書き込み後、

エ.で調べた、列幅の自動調整の命令

Cells.EntireColumn.AutoFit

を使用して、列幅を自動調整してみます。

Private Sub btest001_Click()
    'クエリー QDATA を Excelのシートに書き込む
    
    Dim rs As New ADODB.Recordset  'ADOのレコードセット
    Dim objEXCEL As Object  'Excel参照用

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

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

    '見出しを書き込む
    objEXCEL.Range("A1") = "ドラマタイトル"
    objEXCEL.Range("B1") = "出演者"
    objEXCEL.Range("C1") = "役名"

    Dim yLINE As Integer  '行カウンター

    'ループ処理 レコードが無くなるまで書き込む
    yLINE = 2  '2行目から書き込みたいので、行カウンターを2にする
    While rs.EOF = False  'いつものEOFが偽の間
        'データをセットする(Accessから転記)
        objEXCEL.Cells(yLINE, "A") = rs.Fields("ドラマタイトル")
        objEXCEL.Cells(yLINE, "B") = rs.Fields("出演者")
        objEXCEL.Cells(yLINE, "C") = rs.Fields("役名")
        
        rs.MoveNext  '次のレコードに移動しないと、とんでもないことに(笑)
        yLINE = yLINE + 1  'セット位置も次に移動(+1で一つ下)
    Wend
    
    'Excelシートの列幅を自動調整
    objEXCEL.Cells.EntireColumn.AutoFit
    
    '通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き

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

End Sub

↑データ出力のループが終了したら、

'Excelシートの列幅を自動調整

objEXCEL.Cells.EntireColumn.AutoFit

を1行入れただけです。

グループ単位(ドラマタイトル単位)でシートを作成して書き込む

クエリーからデータを読み込み、

ドラマのタイトルが変わったら、シートを新しく作成して、

シート単位でデータを作成してみました。

作成後、全てのシートに対して

.Cells.EntireColumn.AutoFit

をかけて、列幅を調整してみました。

Private Sub btest002_Click()
    'シート単位でデータを書き込む
    Dim rs As New ADODB.Recordset  'ADOのレコードセット
    Dim objEXCEL As Object  'Excel参照用

    'Excelを起動する
    Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
    objEXCEL.Visible = True  'Excelを見えるようにする
    
    objEXCEL.Workbooks.Add   'Excelのブックを新規に作成(追加)
    
    'レコードセットを開く(QDATA)
    rs.Open "QDATA", CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic

    Dim yLINE As Integer  '行カウンター
    Dim strOLDTITLE As String  '前回行のタイトル
    
    strOLDTITLE = "XXX前回のタイトル"  '初めに違うタイトルとしたいので

    'ループ処理 レコードが無くなるまで書き込む
    While rs.EOF = False  'いつものEOFが偽の間
        'タイトルが変更されたタイミングで新規シートを作る
        If strOLDTITLE <> rs.Fields("ドラマタイトル") Then  'タイトルが変わったら
            'Excelのシートを追加、シート名をドラマタイトルに変更する
            objEXCEL.Sheets.Add  'シートを追加する
            objEXCEL.ActiveSheet.Name = rs.Fields("ドラマタイトル") 'シート名をドラマタイトルにする
            
            '見出しを書き込む
            objEXCEL.Range("A1") = "ドラマタイトル"
            objEXCEL.Range("B1") = "出演者"
            objEXCEL.Range("C1") = "役名"
            
            strOLDTITLE = rs.Fields("ドラマタイトル") 'ドラマのタイトルを覚える、保存する
            yLINE = 2  '2行目から書き込みたいので、行カウンターを2にする
        End If
        
        'データをセットする(Accessから転記)
        objEXCEL.Cells(yLINE, "A") = rs.Fields("ドラマタイトル")
        objEXCEL.Cells(yLINE, "B") = rs.Fields("出演者")
        objEXCEL.Cells(yLINE, "C") = rs.Fields("役名")
        
        rs.MoveNext  '次のレコードに移動しないと、とんでもないことに(笑)
        yLINE = yLINE + 1  'セット位置も次に移動(+1で一つ下)
        
    Wend
    
    'データ書き込み完了後、ループで全てのシートに対して、列幅を自動調整
    Dim n As Integer  'シートのカウンター
    For n = 1 To objEXCEL.Sheets.Count 'シートの数だけ回す
        objEXCEL.Sheets(n).Select  'n番目のシートを選択
        objEXCEL.Cells.EntireColumn.AutoFit  '列幅を自動調整する
    Next
    objEXCEL.Sheets(1).Select  '一番左のシートを選択する

    '通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き

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

End Sub

ここでは、データ転記終了後、

'データ書き込み完了後、ループで全てのシートに対して、列幅を自動調整

Dim n As Integer 'シートのカウンター

For n = 1 To objEXCEL.Sheets.Count 'シートの数だけ回す

objEXCEL.Sheets(n).Select 'n番目のシートを選択

objEXCEL.Cells.EntireColumn.AutoFit '列幅を自動調整する

Next

objEXCEL.Sheets(1).Select '一番左のシートを選択する

で、全てのシートに対して、列幅を自動調整してみました。

※本当は、シートを作りながら1枚1枚調整したかったけど、、、

↓そんな処理でハマった話は、下記の解説動画を見て笑ってください。

操作動画と解説

下記、いつもの動画解説です。※けっこうハマってしまった・・無編集なので30分近くウダウダやってます(ぉぃぉぃ)

D

http://www.youtube.com/watch?v=_ltba_DuW6o

YouTubeに15分以上の動画をUP可能になったので、

調子に乗ってノーカットで、アップしてしまった

※やはり、最低限の編集は必要だったなぁ・・・と思いつつ、15分以上の実験を兼ねてアップしました。


全体の流れ/解説は http://ken3hitori.g.hatena.ne.jp/bbs/18?from=1 を見てください。





[記事一覧、バックナンバーを見る]








ブログトップ 記事一覧 ログイン 無料ブログ開設