スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

Excelへの出力 まとめ(シーズン1) 


Excelへの直出力は、過去記事でいくつか取り上げていましたが、チョッとこの辺で・・・
まとめ的なものを書いておこうかと

直に出力する際に、Excel の書き方で覚えておいた方が良いものを私流に挙げるとすると
・ CopyFromRecordset ★
・ Offset ★
・ Resize ★
・ FormulaR1C1 ★
・ NumberFormatLocal ★
・ Borders ★
・ Visible / SaveAs / DisplayAlerts ★
ここからは、必要に応じて
・ Interior.ColorIndex / Font.ColorIndex ★
・ HorizontalAlignment / VerticalAlignment ★
・ CurrentRegion / UsedRange / SpecialCells
・ ColumnWidth / RowHeight / AutoFit
・ EntireColumn / EntireRow
・ WorksheetFunction.Transpose
・ Merge / Insert / Delete
・ FormatConditions
・ Locked / Protect ★
・ Version ★
・ ・・・

今回は上記 ★ を使ったものになります。
出力指定用のフォームは以下のようになってます。

kEnt188D  kEnt188  kEnt188_2000

※ 右側 2000 では、オプションボタンのラベルがズレちゃいますね
 (動作自体はまともですが・・・ 2007 → 2000 変換後の注意箇所ですね)

「支店」を選択してから、「Excel出力」をクリックすると、
アクセスファイルと同じところに「kEnt188.xls」を作成します。

kEnt188Excel1  kEnt188Excel2

※ 常に上書きしますが、上書きに失敗すると作ったものを表示します。
 それをどうするかは、操作者次第という事で・・・・

※ 連続で出力を確認したい場合、出来上がった「kEnt188.xls」を表示してから、
 いろいろと出力指定してみます。
 すると、表示するだけになるので・・・できたものをいちいち開いて確認・・・の手間が省けます。

※ DoCmd.TransferSpreadsheet acExport っていう方法もあると思いますが
・シート名はクエリ名になる
・余分な列以外の部分はそのまま
 前回出力後、余分な列部分にメモ書きした・・・とか
 その部分もきれいにしてから・・・(シートまるごと綺麗にしてから)・・・ってできないみたい
・余計な情報は付けれない
・罫線引いたり、色付けたり・・・ってできないみたい
・計算式の埋め込みは、できないよね

という事で、私は直に出力する事を良くするんですね・・・・
 
まず、テーブルを用意します。
用意したテーブルは「T商品」「T支店」「T売上」の3つ

●テーブル「T商品」
sid : 長整数(主キー)
商品名 : テキスト
単価 : 通貨

●テーブル「T支店」
kid : 長整数(主キー)
支店名 : テキスト

●テーブル「T売上」
an : オートナンバ(主キー)
日付 : 日付/時刻型
kid : 長整数
※ ルックアップを設定して、テーブル「T支店」を参照する(以下は主な設定箇所)
・表示コントロール : コンボボックス
・値集合ソース : SELECT T支店.kid, T支店.支店名 FROM T支店 ORDER BY T支店.支店名;
・連結列 : 1
・列数 : 2
・列幅 : 0cm;2cm (支店名が見えるように)

sid : 長整数
※ ルックアップを設定して、テーブル「T商品」を参照する(以下は主な設定箇所)
・表示コントロール : コンボボックス
・値集合ソース : SELECT T商品.sid, T商品.商品名, T商品.単価 FROM T商品 ORDER BY T商品.商品名;
・連結列 : 1
・列数 : 3
・列幅 : 0cm;2cm;2cm (商品名:単価が見えるように)
・リスト幅 : 4cm  ※※ ここ、設定していなかったかも(フォーム上では指定してましたが・・・)

数量 : 長整数


このテーブル3つは、こんな感じで結び付けます。

kEnt188Q

用意していたクエリは「Q1」「Q2」「Q3」の3つです。
クエリ「Q1」は
SELECT T売上.日付, T支店.支店名, T商品.商品名, T商品.単価, T売上.数量, T商品.単価*T売上.数量 AS 価格
FROM (T売上 INNER JOIN T支店 ON T売上.kid = T支店.kid) INNER JOIN T商品 ON T売上.sid = T商品.sid
ORDER BY T支店.支店名, T商品.商品名;
で、見るだけ用途に

クエリ「Q2」は
SELECT T売上.日付, T売上.kid, T売上.sid, T商品.単価, T売上.数量, T商品.単価*T売上.数量 AS 価格
FROM (T売上 INNER JOIN T支店 ON T売上.kid = T支店.kid) INNER JOIN T商品 ON T売上.sid = T商品.sid
ORDER BY T売上.日付, T支店.支店名, T商品.商品名;
で、入力もしてみますか

クエリ「Q3」は、クエリ「Q2」の LEFT JOIN バージョン
SELECT T売上.日付, T売上.kid, T売上.sid, T商品.単価, T売上.数量, T商品.単価*T売上.数量 AS 価格
FROM (T売上 LEFT JOIN T支店 ON T売上.kid = T支店.kid) LEFT JOIN T商品 ON T売上.sid = T商品.sid
ORDER BY T売上.日付, T支店.支店名, T商品.商品名;

INNER JOIN を使った方がいいのか・・・ LEFT JOIN を使った方が良いのか・・・
迷う事がチョクチョクありますね・・・・


このテーブル群にサンプルデータを作成するものを、標準モジュール「Module1」に用意しています。

Const CSYOUHIN As Long = 50
Const CSITEN As Long = 20
Const CURIAGE As Long = 500

Public Sub MakeTables()
  Randomize

  Call MkTs
  Call MkTk
  Call MkTu
End Sub

Private Function MkMoji(sSrc As String, iCnt As Long) As String
  Dim sS As String
  Dim iBase As Long
  Dim i As Long

  iBase = Asc(sSrc)
  sS = ""
  For i = 1 To iCnt
    sS = sS & Chr(iBase + Int(Rnd() * 26))
  Next
  MkMoji = sS
End Function

Private Sub MkTs()
  Dim rs As New ADODB.Recordset
  Dim sSql As String
  Dim vAry As Variant
  Dim i As Long, j As Long

  With CreateObject("Scripting.Dictionary")
    While (.Count < CSYOUHIN)
      .Item(MkMoji("a", Int(Rnd() * 5) + 1)) = Null
    Wend
    vAry = .Keys
  End With

  sSql = "DELETE * FROM T商品;"
  CurrentProject.Connection.Execute sSql
  rs.Open "T商品", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
  For i = 0 To UBound(vAry)
    rs.AddNew
    rs("sid") = i + 1
    rs("商品名") = vAry(i)
    j = Int(Rnd() * 1000) * 10
    If (j = 0) Then j = 100
    rs("単価") = j
    rs.Update
  Next
  rs.Close
End Sub

Private Sub MkTk()
  Dim rs As New ADODB.Recordset
  Dim sSql As String
  Dim vAry As Variant
  Dim i As Long

  With CreateObject("Scripting.Dictionary")
    While (.Count < CSITEN)
      .Item(MkMoji("A", Int(Rnd() * 3) + 3)) = Null
    Wend
    vAry = .Keys
  End With

  sSql = "DELETE * FROM T支店;"
  CurrentProject.Connection.Execute sSql
  rs.Open "T支店", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
  For i = 0 To UBound(vAry)
    rs.AddNew
    rs("kid") = i + 1
    rs("支店名") = vAry(i)
    rs.Update
  Next
  rs.Close
End Sub

Private Sub MkTu()
  Dim rs As New ADODB.Recordset
  Dim sSql As String
  Dim dt As Date
  Dim i As Long

  sSql = "DELETE * FROM T売上;"
  CurrentProject.Connection.Execute sSql
  rs.Open "T売上", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
  For i = 1 To CURIAGE
    rs.AddNew
    rs("日付") = DateSerial(Int(Rnd() * 4) + 2010, Int(Rnd() * 12) + 1, Int(Rnd() * 31) + 1)
    rs("kid") = Int(Rnd() * CSITEN) + 1
    rs("sid") = Int(Rnd() * CSYOUHIN) + 1
    rs("数量") = Int(Rnd() * 15) + 1
    rs.Update
  Next
  rs.Close
End Sub

 
MakeTables を実行する事で、
商品数 50 / 支店数 20 / 売上数 500 のレコードが出来上がります。


フォームを作っていきます。
今回、メイン(F1M) / サブ(F1S)の構成にします。
メイン(F1M)は、
・支店選択
・売上期間指定
・Excel 出力
を担当します。
サブ(F1S)は、クエリ「Q2」を元に帳票フォームとして作成します。
で、サブフォームコントロールには、
・リンク親フィールド: 支店選択のコントロール名(cbx1)
・リンク子フィールド: kid

ここで、メイン / サブ に分けないで、帳票フォームヘッダでメインでのものを組み込めば・・・
っていう話もあるかもしれません。
まぁ、今回は、私の好き嫌いという事で・・・・
(レコード数が多い時、横に表示される縦スクロールバーの表示は全体になっちゃう)
(ヘッダ部分には欲しくない・・・・)

これは置いといて・・・


サブフォーム「F1S」の作成

クエリ「Q2」を元にフォームウィザードで作成します。
kid 以外を選択して、表形式で作成します。
「単価」「価格」部分は入力するところではないので、編集ロック:はい / タブストップ:いいえ
「日付」「sid」「数量」は必須入力になるので、背景色をチョッと付けますか・・・
「sid」のラベル部分は「商品」に変更・・・

これで、ほぼ見栄え的にはできたので処理を考えていきます。
このフォームは、サブフォーム組み込み用として使おうと思っているので
・単独起動されたら、編集だけはできるようにしますか・・・
 新規登録するには、kid の情報が足りない・・・ BeforeInsert でキャンセル設定
・コンボボックス「sid」で、表示されているものを削除してみるとエラーが出るね・・・

kEnt188_Err

 Form_Error で、そのエラーなら無視しましょう・・・
 すり抜けてきても、どの道更新前処理で値設定を確認しているので・・・・
 (実際にはエラー表示されなくなるだけで、フォーカス移動はできないけど・・・)

等々・・・ で、記述したのは以下
Dim frm As Form

Private Sub Form_Error(DataErr As Integer, Response As Integer)
  If (DataErr = 3162) Then
    Beep
    Response = acDataErrContinue
  End If
End Sub

Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  Set frm = Me.Parent
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
  If (frm Is Nothing) Then
    Cancel = True
  ElseIf (IsNull(frm.cbx1)) Then
    Cancel = True
  End If
  If (Cancel) Then Beep
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  Dim v As Variant
  Const CCHK As String = "日付,sid,数量"

  For Each v In Split(CCHK, ",")
    If (IsNull(Me(v))) Then
      Cancel = True
      Beep
      Me(v).SetFocus
      Exit Sub
    End If
  Next
End Sub

Private Sub Form_Close()
  Set frm = Nothing
End Sub

 

メインフォーム「F1M」の作成

フォームはデザインから作っていきます。

以下のコントロールを配置します
・「支店」選択用のコンボボックス「cbx1」
 テーブル「T支店」を見るようにします(「T売上」での kid のルックアップ設定と同じ)
・「期間」指定用テキストボックス「txt1」「txt2」
・「Excel出力」用コマンドボタン「btn1」
・「書出し位置」用オプショングループ「op1」(値は 0 ~ 2)

出来上がっていたフォーム「F1S」をドラッグ&ドロップして、サブフォームとして埋め込み
ラベル部分はいらないので削除し、名前を「FSUB」に変更
リンク親フィールド : cbx1
リンク子フィールド : kid
※ このリンク親/子フィールド設定時には、ビルドは使いません(使えません)
 直接、手入力します

動き的には、
・「支店」選択用のコンボボックス「cbx1」が変更されたら・・・・何もしません
 勝手にサブフォーム表示が切り替わるのを眺めます
・「期間」指定用テキストボックス「txt1」「txt2」が変更されたら・・・
 サブフォームの Filter を設定します
・「Excel出力」用コマンドボタン「btn1」がクリックされたら
 支店が選ばれていなかったら、何もしません
 対象支店・対象期間で、データが無ければメッセージ表示して終わります
 データがあれば、Excel を起動して新規ブックに作り込んでいきます。
 (「数量」は期間内のものを合計したもので・・・)
・「書出し位置」用オプショングループ「op1」が変更されたら・・・ 何もしません
 Excel 出力処理時に参照されるだけです。

上記の他では、
初期のサンプルファイルにはデータは入っていません。
フォームが起動された時、「支店」選択用コンボボックスのデータが無ければ、
テーブル3つのデータを作って、再クエリを・・・
(サブフォーム自体と、コンボボックスに対して)

大まかな感じはこんなものです。

記述したのは以下
Private Function myDateRange()
  Dim sS As String
  Const sAndOr As String = " AND "

  sS = ""
  If (Not IsNull(Me.txt1)) Then
    sS = sS & sAndOr & "日付>=#" & Me.txt1 & "#"
  End If
  If (Not IsNull(Me.txt2)) Then
    sS = sS & sAndOr & "日付<=#" & Me.txt2 & "#"
  End If
  sS = Mid(sS, Len(sAndOr) + 1)
  With Me.FSUB.Form
    If (Len(sS) > 0) Then
      .Filter = sS
      .FilterOn = True
    Else
      .FilterOn = False
      .Filter = ""
    End If
  End With
End Function

Private Sub Form_Load()
  If (Me.cbx1.ListCount <= 0) Then
    Call MakeTables
    Me.cbx1.Requery
    With Me.FSUB.Form
      .Requery
      .sid.Requery
    End With
  End If
  Me.txt2 = Date
  Me.txt1.AfterUpdate = "=myDateRange()"
  Me.txt2.AfterUpdate = "=myDateRange()"
  Call myDateRange
End Sub

Private Sub btn1_Click()
  Dim rs As DAO.Recordset
  Dim sSql As String, sRng As String, sS As String
  Dim oApp As Object
  Dim iVer As Long, i As Long
  Const xlContinuous = 1
  Const xlExcel8 = 56
  Const xlHAlignCenter = -4108

  If (IsNull(Me.cbx1)) Then Exit Sub

  sSql = "SELECT First(Q2.支店名) AS 支店名, First(Q3.商品名) AS 商品名, First(Q3.単価) AS 単価, " _
    & "Sum(Q1.数量) AS 数量 FROM (T売上 AS Q1 INNER JOIN T支店 AS Q2 ON Q1.kid = Q2.kid) " _
    & "INNER JOIN T商品 AS Q3 ON Q1.sid = Q3.sid " _
    & "WHERE Q1.kid={%1} {%2} {%3} " _
    & "GROUP BY Q1.sid " _
    & "ORDER BY First(Q3.商品名);"
  sSql = Replace(sSql, "{%1}", Me.cbx1)
  sSql = Replace(sSql, "{%2}", IIf(IsNull(Me.txt1), "", "AND Q1.日付 >= #" & Me.txt1 & "#"))
  sSql = Replace(sSql, "{%3}", IIf(IsNull(Me.txt2), "", "AND Q1.日付 <= #" & Me.txt2 & "#"))
  Set rs = CurrentDb.OpenRecordset(sSql)
  If (rs.EOF) Then
    MsgBox "対象のデータがありません", vbInformation
    rs.Close
    Set rs = Nothing
    Exit Sub
  End If

  rs.MoveLast
  sS = rs.RecordCount & " 件のデータがあります。" & vbCrLf & "Excel 出力しますか?"
  If (MsgBox(sS, vbYesNo + vbQuestion, "確認") = vbYes) Then
    rs.MoveFirst
    Set oApp = CreateObject("Excel.Application")
    iVer = oApp.Version
    oApp.Workbooks.Add
    With oApp.ActiveSheet
      sRng = Chr(Asc("A") + Me.op1) & (Me.op1 + 1) * 2
      With .Range(sRng)
        .Offset(-1) = Me.txt1 & " ~ " & Me.txt2 & " の集計"
        For i = 0 To rs.Fields.Count - 1
          .Offset(0, i) = rs(i).Name
        Next
        .Offset(0, rs.Fields.Count) = "価格"
        With .Resize(1, rs.Fields.Count + 1)
          .HorizontalAlignment = xlHAlignCenter
          .Interior.ColorIndex = 15
        End With
        .Offset(1).CopyFromRecordset rs
        .Offset(1, rs.Fields.Count).Resize(rs.RecordCount, 1).FormulaR1C1 = "=RC[-2]*RC[-1]"
        .Offset(1, 2).Resize(rs.RecordCount, 3).NumberFormatLocal = "#,###"
        .Resize(rs.RecordCount + 1, rs.Fields.Count + 1).Borders.LineStyle = xlContinuous
        With .Offset(1, 3).Resize(rs.RecordCount, 1)
          .Locked = False
          .Interior.ColorIndex = 36
        End With
'        oApp.ActiveSheet.Protection.AllowEditRanges.Add _
'          Title:="範囲1", Range:=.Offset(1, 2).Resize(rs.RecordCount, 2)
'        2007 ではこういう指定もあるみたい (なので oApp が必要だった)
'        これをしなければ、全部 With で記述できたかな
      End With
      .Protect
    End With

    On Error Resume Next
    With oApp
      sS = CurrentProject.Path & "\kEnt188.xls"
      .DisplayAlerts = False ' ★★
      If (iVer >= 12) Then
        .ActiveWorkbook.SaveAs sS, xlExcel8
      Else
        .ActiveWorkbook.SaveAs sS
      End If
      .DisplayAlerts = True ' ★★
      If (Err <> 0) Then
        sS = sS & " 保存で問題がありました。" & vbCrLf _
            & "例えば・・・ ファイルを開いていて上書きできなかったとか。" & vbCrLf _
            & "表示しますので対処してください(" & Err & ")"
        MsgBox sS, vbCritical, "処理結果"
        .Visible = True
      Else
        .Quit
        sS = sS & " で保存しました。"
        MsgBox sS, vbInformation, "処理結果"
      End If
    End With
    Set oApp = Nothing
  End If
  rs.Close
  Set rs = Nothing
End Sub

 
※ SQL を作る部分とかいろいろ・・・書き方を変えてみたりしています。
いろいろな方法を知った上で、自分にシックリくるものを見つけられたらと思います。

※ Excel の参照設定していないので、Excel で使う定数は名前そのままで Const 宣言しときますか

kEnt188Excel1

Excel 出力部分の記述がメインの記事なので、チョッと詳し目に解説してみましょう。

  Set oApp = CreateObject("Excel.Application")
  iVer = oApp.Version
  oApp.Workbooks.Add
  With oApp.ActiveSheet
Excel を起動して、バージョンを入手しておきます
バージョンによって記述を変更するのであれば、この iVer を参照して・・・
Excel 2007 は 12 だったと思います。
新規ブックをオープンして・・・アクティブシートを処理対象に

    sRng = Chr(Asc("A") + Me.op1) & (Me.op1 + 1) * 2
    With .Range(sRng)
オプショングループの値は、0 ~ 2
この式で、"A2" / "B4" / "C6" を作りだして、その位置を基準とします。

       .Offset(-1) = Me.txt1 & " ~ " & Me.txt2 & " の集計"
1つ上の行のセルに期間情報を埋め込み

      For i = 0 To rs.Fields.Count - 1
        .Offset(0, i) = rs(i).Name
      Next
      .Offset(0, rs.Fields.Count) = "価格"
      With .Resize(1, rs.Fields.Count + 1)
        .HorizontalAlignment = xlHAlignCenter
        .Interior.ColorIndex = 15
      End With
レコードセットのフィールド名部分を、基準から横に展開
この時、
自分はどの順(フィールド順)でデータを得ていたのか・・・これは意識する必要があります
計算式を付加する部分の項目名に「価格」を設定
この項目名部分を Resize で指定して
・横方向を中央寄せに
・背景の色(グレーの薄めの)15 を設定

      .Offset(1).CopyFromRecordset rs
基準の1行下に CopyFromRecordset でレコードセットの内容を転記
※ この時、rs の位置は MoveFirst で先頭にしておきます。
 Open 直後は先頭になっているので、その時には不要です。
 というのは、 CopyFromRecordset は今参照しているレコード位置から転記するみたい・・・
 今回は、レコード数を求めるのに MoveLast していたので、先頭で MoveFirst しておいた

     .Offset(1, rs.Fields.Count).Resize(rs.RecordCount, 1).FormulaR1C1 = "=RC[-2]*RC[-1]"
基準から、
1行下のフィールド数移動したところ・・・・つまり、計算式を埋め込む「価格」最初の行から
行方向にレコード数分広げた範囲を指定しておいて・・・・計算式を埋め込む
計算式 "=RC[-2]*RC[-1]" は、同じ行の2つ前の列と同じ行1つ前の列のものを "*" して・・・
[] で数字を挟むと相対参照・・・・ [] を使わなければ絶対参照・・・ の様です。
「C2」に埋め込む時に、「A1」を
・絶対参照:R1C1 → $A$1
・相対参照:R[-1]C[-2] → A1
・混在:R1C[-2] → A$1 / R[-1]C1 → $A1
※ 同じ行 / 同じ列 を参照する時には、数字を書かなければ・・・
 「C2」に埋め込む時に、RC[2] → E2 ・・・・

      .Offset(1, 2).Resize(rs.RecordCount, 3).NumberFormatLocal = "#,###"
基準から、
1行下で2つ右に行ったところ・・・「単価」のレコード先頭位置から
行方向にレコード数分、列方向に3つ広げた・・・
Resize での 3 は、自分も含むので「単価」「数量」「価格」のレコード範囲
その範囲に #,### の書式を設定

      .Resize(rs.RecordCount + 1, rs.Fields.Count + 1).Borders.LineStyle = xlContinuous
基準から、
行方向(項目部分+レコード数)、列方向(フィールド数+「価格」の1)を範囲指定して
罫線を引く

      With .Offset(1, 3).Resize(rs.RecordCount, 1)
        .Locked = False
        .Interior.ColorIndex = 36
      End With
基準から、
1行下3つ右に行ったところ・・・「数量」のデータ部分を範囲指定して
・ Locked を解除(シートを保護しても書き換えれる様に)
・解除範囲を見易くするために、背景の色(黄色の薄めの)36 を設定

'        oApp.ActiveSheet.Protection.AllowEditRanges.Add _
'          Title:="範囲1", Range:=.Offset(1, 2).Resize(rs.RecordCount, 2)
'        2007 ではこういう指定もあるみたい (なので oApp が必要だった)
'        これをしなければ、全部 With で記述できたかな
      End With
      .Protect
ここで、アクティブシートに対して、シートの保護

    End With

    On Error Resume Next
    With oApp
    sS = CurrentProject.Path & "\kEnt188.xls"
書き出す Excel ファイル名を生成して

    .DisplayAlerts = False ' ★★
    If (iVer >= 12) Then
      .ActiveWorkbook.SaveAs sS, xlExcel8
    Else
      .ActiveWorkbook.SaveAs sS
    End If
    .DisplayAlerts = True ' ★★
メッセージを出さないで、上書き出来る様に ★★ 部分を指定
※ 今回、保存する Excel ファイルの拡張子は「xls」にしたので、
バージョンが Excel2007 以上の時には、FileFormat を指定する様に・・・

    If (Err <> 0) Then
      sS = sS & " 保存で問題がありました。" & vbCrLf _
          & "例えば・・・ ファイルを開いていて上書きできなかったとか。" & vbCrLf _
          & "表示しますので対処してください(" & Err & ")"
      MsgBox sS, vbCritical, "処理結果"
      .Visible = True
    Else
      .Quit
      sS = sS & " で保存しました。"
      MsgBox sS, vbInformation, "処理結果"
    End If
SaveAs で保存した後の Err をみて・・・・
エラーがなかったら、Excel を終了させてメッセージ通知
(ワークブックは保存できたので、改めて Close してから Quit でなくても良いんでしょう・・・かな)
問題があったら、それ用のメッセージ通知後 Excel を表示する様に Visible = True に

ってな感じで処理が流れます・・・
そんなに難しい事はしてませんよね・・・

皆さんなのか・・・良く目にするのは
Excel を起動して・・・・ すぐに Visible = True ・・・・
これって、途中にエラーがあった時に Excel を閉じやすく・・・ っていう意味なんでしょうか?
それとも、処理の過程を見せる事で操作を止めさせる・・・ っていう意図でもあるんでしょうか?

私の考え方は、
出来上がるまで Visible = False 状態で良いでしょう・・・
画面に表示しない分、処理は速くなる?
出来上がってから・・・ はい、どうぞ・・・ ってなのが好き・・・
また、どういう動きをしているかわからないけど
4年前 QA(5497486)で、Visible = True を先頭ではなく最後にしたらうまくいった・・・・ あったよな・・・


最近の質問にあったのですが
・支店別で、ファイル名に支店名を使いたい
・レコードセットに無い余分なものを付加したい(計算式とか)
・罫線を引きたい
・シート保護したい(部分的にいじれるように)

としたら、雰囲気以下の様になるのでしょうか

・対象の支店を得る ★1
レコードがあったら
・Excel起動
 ・・★1の支店を使ってデータ入手
  レコードがあったら
  ・・新規ブック作成
   ・・データ転記 / 要求分を作成(この部分、上記を参考にすればチョイ?)
  ・・新規ブックの保存 & クローズ
・Excel終了

上記の ・・ 部分を ★1 データで繰り返せば・・・
で、ブックの保存でエラーならそのままにしておいて、正常ならクローズして・・・
最終的にクローズされていないものがあったら、Excelを終了せずに Visible = True するとか・・・


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt188_2000.zipkEnt188_2003.zipkEnt188_2007.zip
 サイズ 40,08741,02143,502
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

※ サンプルファイル初期には、データは入っていません。
フォーム「F1M」を起動するか、
標準モジュール「Module1」の MakeTables を実行する事でサンプル用データは出来上がります。
データを変更したい場合、MakeTables を実行すると作り直されます。


※ Excel 直出力を使う利点は、主にクロス集計での出力だと思います
 クロス集計では
・列数が定まらない
・レポートでは決められた幅内で納めなければならない?
これ、Excel直出力で・・・印刷の倍率?を設定すれば、用途は広くなりますよね・・・・

また、新規ブックへの作成ではなく、既存Excelファイルへの穴埋めなど・・・
VBA の記述は増えるかもしれませんが、自由度は高い様な気がします。

何を使うかは・・・環境・考え方次第だと思います・・・・っと、まとめてみる・・・・
関連記事

2013/12/14

Category: サンプルかな

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。