FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

出力項目指定の模索 


あるテーブルに、「生徒名」「生年月日」「ゼミコード」「部活コード」「年齢」のフィールドがあって、
例えば、CSV 出力するもの & 順番を指定するものを作りたい。

出力するもの:チェックボックスでチェックしたものを対象に・・・・
順番:横に順番を指定するテキストボックスを表示し、数字を入力・・・で、この順

こんな感じっていうのを、回答してみました。
これが、フォーム「F1」
kEnt154_1
なお、回答してみたけど反応無く・・・残り xx 時間になったら、回答は削除しています。
この質問がどうなるかは、わかりません。
ナゼ削除 ???
実際の環境は質問者以外わからず・・・・適正なジャッジが出来るとは思えない・・・
投票になり、過去に同席した際・・・・あの方が BA か ?? ・・・でも、質問ごと削除・・・・・・・・・・・・
誰が・・・どんな・・・ジャッジしてるの ????

回答したのは、画面周りだけのものなので・・・・
じゃ、設定したものを再利用できるようにしてみましょうか・・・・
設定状況を保存しておくテーブルを用意し、
また、どのテーブル/クエリが対象・・・・選択できるコンボボックスを新設
これが、フォーム「F2」
kEnt154_2  kEnt154_2A  kEnt154_2D

フォーム「F1」「F2」では、順を指定する数字は重複云々・・・自由だったけど・・・
指定順は、常に 1 ~ 順に・・・・
数字を変更したらそれなりに移動してみますか・・・・
これが、フォーム「F3」
kEnt154_3

じゃ、それに「再読込み」「クリア」の機能も付けてみますか・・・・
これが、フォーム「F4」
kEnt154_4

では、出来上がったテーブルを利用して、CSV に出力するには・・・・の例を・・・


※ なんか、ブログの仕様等変わったのかなぁ??

いろいろと VBA を記述してますが、¥ マークがうまく表示されなくなったような気がします。
パス記述部分だったり、演算子部分だったり・・・・
¥ を ¥ に置き換えましたが、抜けている部分があるかもしれません。
記事内の VBA 記述はサンプルファイルと一緒なので・・・不都合あれば、ファイルの方を参照ください。
 

フォーム「F1」

kEnt154_1

このフォームは、回答したそのものになります

Access で良かったでしょうか

解釈違いしているかもしれませんが、画面周りについて・・・

テキストボックス名を「txt1」~「txtXX」
チェックボックス名を「cb1」~「cbXX」
コマンドボタン名を「btn1」と仮定します。

※ XX は、
  Const sFN As String = "生徒名,生年月日,ゼミコード,部活コード,年齢"
の設定で変化

以下を標準モジュールに記述し、実行すると最低限の設定でフォームが出来ます。
Public Sub MakeForm()
  Const IPX As Integer = 567
  Const sFN As String = "生徒名,生年月日,ゼミコード,部活コード,年齢"
  Dim i As Integer, j As Integer
  Dim v As Variant
  Dim s As String

  With CreateForm
    i = 1
    For Each v In Split(sFN, ",")
      j = (i - 1) * IPX * 0.7 + IPX * 0.5
      With CreateControl(.Name, acTextBox, acDetail)
        .Name = "txt" & i
        .Top = j
        .Left = IPX
        .Width = IPX * 0.5
        .Height = IPX * 0.5
        .TabStop = False
      End With
      With CreateControl(.Name, acCheckBox, acDetail)
        s = "cb" & i
        .Name = s
        .Top = j
        .Left = IPX * 1.7
        .Width = IPX * 0.5
        .Height = IPX * 0.5
        .DefaultValue = 0
      End With
      With CreateControl(.Name, acLabel, acDetail, s)
        .Top = j
        .Left = IPX * 2.3
        .Width = IPX * 2.5
        .Height = IPX * 0.5
        .Caption = v
      End With
      i = i + 1
    Next
    With CreateControl(.Name, acCommandButton, acDetail)
      .Name = "btn1"
      .Top = IPX * 0.5
      .Left = IPX * 6.5
      .Width = IPX * 2
      .Height = IPX * 0.7
      .Caption = "決定"
    End With
  End With
End Sub

デザインで表示されているコマンドボタンのクリック時を [イベントプロシージャ]にし、右横の [....] をクリックします。
そこに、以下を記述し動作を確認してみます。
Dim iCnt As Long

Private Function cbAllCange()
  On Error Resume Next
  With Me("txt" & Mid(Me.ActiveControl.Name, 3))
    .Value = Null
    .Enabled = Me.ActiveControl
    .SetFocus
  End With
End Function

Private Sub Form_Load()
  Dim ctl As Control

  iCnt = 0
  For Each ctl In Me.Section(acDetail).Controls
    With ctl
      If (.ControlType = acCheckBox) Then
        iCnt = iCnt + 1
        .Value = False
        .AfterUpdate = "=cbAllCange()"
        With Me("txt" & Mid(.Name, 3))
          .Value = Null
          .Enabled = False
          .ValidationRule = "Not Like '*[!0-9]*'"
        End With
      End If
    End With
  Next
End Sub

Private Sub btn1_Click()
  Dim dic As Object
  Dim i As Long, j As Long
  Dim v As Variant, vTmp As Variant
  Dim sS As String

  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To iCnt
    With Me("txt" & i)
      If (.Enabled) Then
        j = Nz(.Value, 0)
        v = dic.Item(j)
        If (Not IsArray(v)) Then
          ReDim v(0)
        Else
          ReDim Preserve v(UBound(v) + 1)
        End If
        v(UBound(v)) = i
        dic.Item(j) = v
      End If
    End With
  Next

  sS = ""
  If (dic.Count > 0) Then
    v = dic.Keys
    For i = 0 To UBound(v) - 1
      For j = i + 1 To UBound(v)
        If (v(i) > v(j)) Then
          vTmp = v(i)
          v(i) = v(j)
          v(j) = vTmp
        End If
      Next
    Next
    For i = 0 To UBound(v)
      vTmp = dic.Item(v(i))
      For j = 0 To UBound(vTmp)
        sS = sS & ", " & Me("cb" & vTmp(j)).Controls(0).Caption
      Next
    Next
    sS = Mid(sS, 3)
  End If

  Set dic = Nothing
  MsgBox sS
End Sub

「決定」をクリックするとメッセージボックスで、出来上がった文字列を表示します。
この出来上がった文字列を使って SELECT 文字列 FROM XXXX とか記述すれば・・・
また、sS を作っている段階でテーブルに登録するとか・・・

> 登録時には数値の順番は競合していないかと
> 1から最後の数値をチェックして、間に漏れがないかとチェックします。

数値が競合した場合は、上から順に並べます。(Access風だと、文字順みたい)
また、数値は綺麗に連続していなくても OK とするようにしました。

今回、フォームを作る時にチェックボックス等の個数を決定しましたが、
10個位作っておいて、起動時に対象のものを設定・不要部分を非表示・・・・
など、変更点はいっぱいあるかと思います。

> SQL文での照会を見据えた、
> データベース設計を教えていただけると助かります。
これは使いやすい様にされればと思います。


※ 不都合あれば、修正してください。

画面を作る部分は、標準モジュール「Module1」に記述しています。
これを実行すると、最低限のもので作られるので・・・・
レコードセレクタ・移動ボタン・スクロールバー・・・・をそれなりに設定します。

画面上の動きは・・・というと
・チェックボックスがクリックされたら、隣のテキストボックスの Enabled を変更します。
 テキストボックスの値を初期状態( Null )に設定し、フォーカスをテキストボックスに・・・
 この時、Enabled = False であればエラーになるので、エラーは無視する様に
・フォーム読み込み時には、チェックボックス/テキストボックスを初期状態にして、
 イベントの設定/入力規則の設定
・「決定」がクリックされたら
 値の重複を許しているので、それを扱いながらソートでもできるように Dictionary を導入・・・・
 Dictionary のキーには、テキストボックスに入力された数値を用い、
 重複を扱えるように、設定する値は配列にして・・・中の値は、テキストボックス名後ろの数字を・・・
 重複がある場合は、この配列が大きくなっていくだけです。
 で、このキーとした数値でソート後、順に配列内の数値を使って、
 チェックボックスに関連付けられたラベルの Caption を文字列に展開・・・・

 ※ この配列を作る際、単に後ろに・・・・していましたが、Access 風では文字列の順になるようです。
   ( OrdinalPosition が重複した時、フィールド名順になる・・・・とかですね)

※※ このフォームの記述でも、以降のフォームの記述でも、動くには動きますが・・・注意が必要です。
今回、テキストボックスの書式を設定していなかったので、文字列として扱われるようです。
入力規則を
          .ValidationRule = "Not Like '*[!0-9]*'"
として、0 ~ 9 以外の入力を受け付けないようにしました。
が、.Value で見ると数値ではなく、数字(文字列)となるようです。
けど、数値と比較する場合、.Value が数値に変換できるので、変換した後比較してくれているようです。
なので、Variant へ代入する時・代入した後、文字・文字の比較にならない様、片側を数値にしておきました。

回答した内容は、順に文字列を作って MsgBox で表示するだけだったので、再利用を考えてみます。


再利用への細工

再利用・・・・簡単に言えば、テーブルを用意して順を覚えておきましょう・・・・・ですね。
で、テーブルの構成として2つは考えられますね。
1)「オートナンバ」「テーブル/クエリ名」「フィールド名の羅列」
2)「オートナンバ」「テーブル/クエリ名」「順」「フィールド名」
これは個人使用の場合で、
複数人の場合には「操作している人を特定できる何か」(社員番号とか)を追加すれば・・・・

さて、このテーブルを作ったとして、後に控える操作には何があるんだろう???
普通に考えれば 2) の構成になるのかな???
でも、後で使う時に「順」でフィールド名の羅列に展開するだけだったら 1) で良いんじゃないの?
羅列をばらす・・・これらを設定するフォームに集約しておけば・・・・

という事で、今回 1) を採用しました。
テーブル「T_CSV」として
anTQNMFLDS
4 T_CSV1 TQNM, 番号, FLDS
22 T1 F1, F2, F4, F6, F15, F13, F11, F9, F18, F7, F17
28 Q1 TQNM, TQNM1, FLDS, FLDS1

※ 内容は、確認していた時のもので、テーブル数個、クエリ1個を確認用に作ってました。

対象の「テーブル/クエリ」を選択できるようにする・・・・これは、=フィールド数が増減・・・
設定するチェックボックス・テキストボックスを30個用意しておいて、不要なものを非表示・・・

基本となる部分を VBA で作成します。(「Module2」の以下を実行)
Public Sub MakeForm()
  Const IPX As Integer = 567
  Const CNUM As Integer = 10
  Const CCNT As Integer = 30
  Dim i As Integer, j As Integer, k As Integer
  Dim s As String

  With CreateForm
    .RecordSelectors = False
    .NavigationButtons = False
    i = 1
    While (i <= CCNT)
      If (((i - 1) Mod CNUM) = 0) Then
        j = IPX * 3
        k = (i ¥ CNUM) * IPX * 4 + IPX * 0.5
      Else
        j = j + IPX * 0.7
      End If
      With CreateControl(.Name, acTextBox, acDetail)
        .Name = "txt" & i
        .Top = j
        .Left = k
        .Width = IPX * 0.5
        .Height = IPX * 0.5
        .TabStop = False
        .Visible = False
      End With
      With CreateControl(.Name, acCheckBox, acDetail)
        s = "cb" & i
        .Name = s
        .Top = j
        .Left = k + IPX * 0.7
        .Width = IPX * 0.5
        .Height = IPX * 0.5
        .DefaultValue = 0
        .Visible = False
      End With
      With CreateControl(.Name, acLabel, acDetail, s)
        .Top = j
        .Left = k + IPX * 1.3
        .Width = IPX * 2.5
        .Height = IPX * 0.5
      End With
      i = i + 1
    Wend
    With CreateControl(.Name, acCommandButton, acDetail)
      .Name = "btn1"
      .Top = IPX * 0.5
      .Left = IPX * 10
      .Width = IPX * 2
      .Height = IPX * 1
      .Caption = "決定"
    End With
  End With
End Sub

 
これで、基本となるチェックボックス・テキストボックス部分は出来上がります。
「テーブル/クエリ」を選択するコンボボックス「cbx1」を配置します。
値集合タイプ:テーブル/クエリ
値集合ソース:
SELECT Name FROM MSysObjects
WHERE Type IN (1,5) AND Name Not Like 'MSys*' AND Name Not Like '~*' ORDER BY Name;

このコンボボックスで選択した後、フィールド名を得る必要があります。
自分でレコードセットを得て・・・・これ、面倒なのでリストボックスを使います。
非表示のリストボックス「lst1」を配置します。
値集合タイプ:フィールド リスト
値集合ソース:T_CSV

コンボボックスが変更されたら、
リストボックスの値集合ソースを変更し、フィールドの一覧を得る・・・・

こんな感じの動きにします。

※※ クロス集計クエリの場合はどうなるんでしょう??(今回未検証)


フォーム「F2」

kEnt154_2  kEnt154_2A  kEnt154_2D
フォーム「F2」の処理は、フォーム「F1」の動作を継承します。
異なる部分は、
・初期表示・・・・テキストボックス・チェックボックスは非表示
・設定時、入力する数字は重複 OK ・・・
・コンボボックスで選んだ時の初期表示は、1 ~ 順に・・・・

で、VBA 記述したものは以下
Dim iCnt As Long

Private Function cbAllCange()
  On Error Resume Next
  With Me("txt" & Mid(Me.ActiveControl.Name, 3))
    .Value = Null
    .Enabled = Me.ActiveControl
    .SetFocus
  End With
End Function

Private Sub Form_Load()
  Dim ctl As Control

  iCnt = 0
  For Each ctl In Me.Section(acDetail).Controls
    With ctl
      If (.ControlType = acCheckBox) Then
        iCnt = iCnt + 1
        .Visible = False
        .AfterUpdate = "=cbAllCange()"
        With Me("txt" & Mid(.Name, 3))
          .Visible = False
          .ValidationRule = "Not Like '*[!0-9]*'"
        End With
      End If
    End With
  Next
End Sub


Private Sub cbx1_Click()
  Dim i As Long, j As Long
  Dim vG As Variant, v As Variant

  Me.Painting = False
  If (IsNull(Me.cbx1)) Then
    For i = 1 To iCnt
      Me("cb" & i).Visible = False
      Me("txt" & i).Visible = False
    Next
  Else
    Me.lst1.RowSource = Me.cbx1
    For i = 1 To Me.lst1.ListCount
      If (i > iCnt) Then Exit For
      With Me("cb" & i)
        .Value = False
        .Controls(0).Caption = Me.lst1.ItemData(i - 1)
        .Visible = True
      End With
      With Me("txt" & i)
        .Value = Null
        .Enabled = False
        .Visible = True
      End With
    Next
    For j = i To iCnt
      Me("cb" & j).Visible = False
      Me("txt" & j).Visible = False
    Next
    vG = DLookup("FLDS", "T_CSV", "TQNM='" & Me.cbx1 & "'")
    If (Len(Nz(vG)) > 0) Then
      i = 0
      For Each v In Split(vG, ",")
        v = Trim(v)
        For j = 1 To iCnt
          With Me("cb" & j)
            If (Not .Visible) Then Exit For
            If (.Controls(0).Caption = v) Then
              .Value = True
              With Me("txt" & j)
                i = i + 1
                .Value = i
                .Enabled = True
              End With
              Exit For
            End If
          End With
        Next
      Next
    End If
  End If
  Me.Painting = True
End Sub

Private Sub btn1_Click()
  Dim dic As Object
  Dim i As Long, j As Long
  Dim v As Variant, vTmp As Variant
  Dim sS As String
  Dim sSql As String

  If (IsNull(Me.cbx1)) Then Exit Sub
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To iCnt
    With Me("txt" & i)
      If (Not .Visible) Then Exit For
      If (.Enabled) Then
        j = Nz(.Value, 0)
        v = dic.Item(j)
        If (Not IsArray(v)) Then
          ReDim v(0)
        Else
          ReDim Preserve v(UBound(v) + 1)
        End If
        v(UBound(v)) = i
        dic.Item(j) = v
      End If
    End With
  Next

  sS = ""
  If (dic.Count > 0) Then
    v = dic.Keys
    For i = 0 To UBound(v) - 1
      For j = i + 1 To UBound(v)
        If (v(i) > v(j)) Then
          vTmp = v(i)
          v(i) = v(j)
          v(j) = vTmp
        End If
      Next
    Next
    For i = 0 To UBound(v)
      vTmp = dic.Item(v(i))
      For j = 0 To UBound(vTmp)
        sS = sS & ", " & Me("cb" & vTmp(j)).Controls(0).Caption
      Next
    Next
    sS = Mid(sS, 3)
  End If

  Set dic = Nothing
  MsgBox sS

  With CurrentDb
    .Execute "DELETE * FROM T_CSV WHERE TQNM='" & Me.cbx1 & "';"
    sSql = "INSERT INTO T_CSV(TQNM,FLDS) VALUES ('{%1}','{%2}');"
    sSql = Replace(sSql, "{%1}", Me.cbx1)
    sSql = Replace(sSql, "{%2}", sS)
    .Execute sSql
  End With
End Sub

 


フォーム「F3」

kEnt154_3
フォーム「F2」では、チェックボックスを True にした際、必ず(?)数字の入力が必要でした。
そこで、
・表示/入力は 1 ~ の連番に固定
・チェックボックスを True にした時点で、その時の数字を割り当て・・・
・チェックボックスを False にした時点で、連番になるように再設定
・数字が変更されたら、連番になるように数字の再設定

で、1 ~ 連番の設定・・・・・
この方法に変更した事で、「決定」ボタンで作成するフィールド名の羅列作成処理が簡単に・・・・

VBA 記述したのは以下
Dim iCnt As Long
Dim iNumMax As Long

Private Sub DelRep(v As Variant)
  Dim i As Long, j As Long

  For i = 1 To iCnt
    With Me("txt" & i)
      If (Not .Visible) Then Exit For
      If (.Enabled) Then
        j = Val(.Tag)
        If ((v(0) <= j) And (j <= v(1))) Then
          .Value = .Value + 1
        ElseIf ((v(2) <= j) And (j <= v(3))) Then
          .Value = .Value - 1
        End If
        .Tag = .Value
      End If
    End With
  Next
  iNumMax = iNumMax + v(4)
End Sub

Private Function cbAllCange()
  If (Me.ActiveControl) Then
    With Me("txt" & Mid(Me.ActiveControl.Name, 3))
      iNumMax = iNumMax + 1
      .Value = iNumMax
      .Tag = iNumMax
      .Enabled = True
      .SetFocus
    End With
  Else
    With Me("txt" & Mid(Me.ActiveControl.Name, 3))
      Call DelRep(Array(0, 0, Val(.Tag) + 1, iNumMax, -1))
      .Value = Null
      .Tag = ""
      .Enabled = False
    End With
  End If
End Function

Private Function txtAllChange()
  Dim i As Long
  Dim v As Variant

  With Me.ActiveControl
    i = Val(.Tag)
    If (.Value = 0) Then .Value = 1
    If (.Value > iNumMax) Then .Value = iNumMax
    If (.Value <> i) Then
      If (.Value < i) Then
        v = Array(.Value, i - 1, 0, 0, 0)
      Else
        v = Array(0, 0, i + 1, .Value, 0)
      End If
      Call DelRep(v)
      .Tag = .Value
    End If
  End With
End Function

Private Sub Form_Load()
  Dim ctl As Control

  iCnt = 0
  For Each ctl In Me.Section(acDetail).Controls
    With ctl
      If (.ControlType = acCheckBox) Then
        iCnt = iCnt + 1
        .Visible = False
        .AfterUpdate = "=cbAllCange()"
        With Me("txt" & Mid(.Name, 3))
          .Visible = False
          .ValidationRule = "Not Like '*[!0-9]*'"
          .AfterUpdate = "=txtAllChange()"
        End With
      End If
    End With
  Next
End Sub


Private Sub cbx1_Click()
  Dim i As Long
  Dim vG As Variant, v As Variant

  Me.Painting = False
  If (IsNull(Me.cbx1)) Then
    For i = 1 To iCnt
      Me("cb" & i).Visible = False
      Me("txt" & i).Visible = False
    Next
  Else
    Me.lst1.RowSource = Me.cbx1
    For i = 1 To iCnt
      If (i > Me.lst1.ListCount) Then
        Me("cb" & i).Visible = False
        Me("txt" & i).Visible = False
      Else
        With Me("cb" & i)
          .Value = False
          .Controls(0).Caption = Me.lst1.ItemData(i - 1)
          .Visible = True
        End With
        With Me("txt" & i)
          .Value = Null
          .Tag = ""
          .Enabled = False
          .Visible = True
        End With
      End If
    Next

    iNumMax = 0
    vG = DLookup("FLDS", "T_CSV", "TQNM='" & Me.cbx1 & "'")
    If (Len(Nz(vG)) > 0) Then
      For Each v In Split(vG, ",")
        v = Trim(v)
        For i = 1 To iCnt
          With Me("cb" & i)
            If (Not .Visible) Then Exit For
            If (.Controls(0).Caption = v) Then
              .Value = True
              With Me("txt" & i)
                iNumMax = iNumMax + 1
                .Value = iNumMax
                .Tag = iNumMax
                .Enabled = True
              End With
              Exit For
            End If
          End With
        Next
      Next
    End If
  End If
  Me.Painting = True
End Sub

Private Sub btn1_Click()
  Dim sAry() As String
  Dim i As Long
  Dim sS As String
  Dim sSql As String

  If (IsNull(Me.cbx1)) Then Exit Sub
  sS = ""
  If (iNumMax > 0) Then
    ReDim sAry(1 To iNumMax)
    For i = 1 To iCnt
      With Me("txt" & i)
        If (Not .Visible) Then Exit For
        If (.Enabled) Then
          sAry(.Value) = Me("cb" & i).Controls(0).Caption
        End If
      End With
    Next
    sS = Join(sAry, ", ")
  End If
  MsgBox sS

  With CurrentDb
    .Execute "DELETE * FROM T_CSV WHERE TQNM='" & Me.cbx1 & "';"
    sSql = "INSERT INTO T_CSV(TQNM,FLDS) VALUES ('{%1}','{%2}');"
    sSql = Replace(sSql, "{%1}", Me.cbx1)
    sSql = Replace(sSql, "{%2}", sS)
    .Execute sSql
  End With
End Sub

 
※ 非連結のテキストボックスで内容を変更すると、変更前の値は???
 これ、なんか・・・わからないので、その時の値を .Tag に覚えておく方法にしました。
 (連結であれば、.OldValue で前の値がわかるのですけど・・・・)

※ どちらの書き方が好きでしょうか・・・
「テーブル/クエリ」が選択されて・・・そのフィールドを画面に展開する時の記述ですが
(フィールド数以外を非表示にするところ)
フォーム「F2」に記述したのは
    Me.lst1.RowSource = Me.cbx1
    For i = 1 To Me.lst1.ListCount
      If (i > iCnt) Then Exit For
      With Me("cb" & i)
        .Value = False
        .Controls(0).Caption = Me.lst1.ItemData(i - 1)
        .Visible = True
      End With
      With Me("txt" & i)
        .Value = Null
        .Enabled = False
        .Visible = True
      End With
    Next
    For j = i To iCnt
      Me("cb" & j).Visible = False
      Me("txt" & j).Visible = False
    Next

フォーム「F3」に記述したのは
    Me.lst1.RowSource = Me.cbx1
    For i = 1 To iCnt
      If (i > Me.lst1.ListCount) Then
        Me("cb" & i).Visible = False
        Me("txt" & i).Visible = False
      Else
        With Me("cb" & i)
          .Value = False
          .Controls(0).Caption = Me.lst1.ItemData(i - 1)
          .Visible = True
        End With
        With Me("txt" & i)
          .Value = Null
          .Tag = ""
          .Enabled = False
          .Visible = True
        End With
      End If
    Next

どちらもやっている事は同じなんですけど・・・・


フォーム「F4」

kEnt154_4
このフォーム「F4」は、フォーム「F3」に「再読込み」「クリア」機能を付けただけです。

で、追加した記述は以下になります。
Private Sub btn2_Click()
  Call cbx1_Click
End Sub

Private Sub btn3_Click()
  Dim i As Long

  If (IsNull(Me.cbx1)) Then Exit Sub
  Me.Painting = False
  For i = 1 To iCnt
    With Me("cb" & i)
      If (Not .Visible) Then Exit For
      .Value = False
    End With
    With Me("txt" & i)
      .Value = Null
      .Tag = ""
      .Enabled = False
    End With
  Next
  iNumMax = 0
  Me.Painting = True
End Sub

 


CSV 出力の例

今回、テーブル「T_CSV」を作ったので、
  v = DLookup("FLDS", "T_CSV", "TQNM='" & sTQNM & "'")

とすれば、フィールド名の羅列が得られます。この後、
  sSql = "SELECT " & v & " FROM " & sTQNM & ";"
とかすれば、選択クエリ用の SQL が出来上がります。
これを使って、テンポラリのクエリを作成して DoCmd なんチャラ・・・・・って方法でも良いと思います。

ここでは、SQL から CSV ファイルを作る方法を・・・・(過去記事でも扱っていたかと)
SQL から作成する時には、その CSV ファイルが存在するとエラーになるので、
Kill で削除してから・・・(なかった場合もあるかも・・・・でエラーを無視)

以下は、「Module3」に記述してます
Public Sub OutCsv(sTQNM As String, sPath As String, sFile As String)
  Dim v As Variant
  Dim sSql As String
  Const sSqlBase As String = _
    "SELECT {%1} INTO [{%2}] IN '{%3}'[Text;FMT=Delimited;HDR=YES;IMEX=0;] FROM {%4};"

  On Error Resume Next
  v = DLookup("FLDS", "T_CSV", "TQNM='" & sTQNM & "'")
  If (Len(Nz(v)) > 0) Then
    Kill sPath & "¥" & sFile
    sSql = sSqlBase
    sSql = Replace(sSql, "{%1}", v)
    sSql = Replace(sSql, "{%2}", sFile)
    sSql = Replace(sSql, "{%3}", sPath)
    sSql = Replace(sSql, "{%4}", sTQNM)
    CurrentDb.Execute sSql
  End If
End Sub

Public Sub test()
'  Call OutCsv("T1", "E:¥Access¥2007", "ent154_1.csv")
'  Call OutCsv("Q1", "E:¥Access¥2007", "ent154_2.csv")
End Sub

 
これで、一応出力される事は確認できました。
ま、実際には、いろんなエラーを判別・対処できるように記述するんでしょうが・・・・


あっ、そうそう・・・・
「テーブル/クエリ」で、選択するものを表示する際、 UPDATE / INSERT / DELETE ・・・
なのかどうかまでは見ていません。
命名規則等で、はじく等々・・・・の工夫は必要と思います。


う~~ん
チェックボックスかぁ・・・・・
リストボックスを2つ並べて、ギッコンバッタンでも良い様な気もする・・・・
(過去に記事にしていたような・・・)



サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt154_2000.zipkEnt154_2003.zipkEnt154_2007.zip
 サイズ 67,49470,77478,140
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2013/04/06

Category: サンプルかな

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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