SELECT Sum(IIf([損益分類ID]=4,[損益分類合計],0)) AS 期首在庫, Sum(IIf([損益分類ID]=3,[損益分類合計],0)) AS 仕入高, [期首在庫]+[仕入高] AS 当期仕入, Sum(IIf([損益分類ID]=5,[損益分類合計],0)) AS 期末在庫, [当期仕入]-[期末在庫] AS 売上原価, Sum(IIf([損益分類ID]=1,[損益分類合計],0)) AS 製品売上高, Sum(IIf([損益分類ID]=2,[損益分類合計],0)) AS 家賃収入, [製品売上高]+[家賃収入] AS 収入計, [収入計]-[売上原価] AS 売上総利益, Sum(IIf([損益分類ID]=6,[損益分類合計],0)) AS 販管費, [売上総利益]-[販管費] AS 営業利益, Sum(IIf([損益分類ID] In (7,8,9),[損益分類合計],0)) AS 営業外収益, Sum(IIf([損益分類ID] In (10,11,12,13,14,15),[損益分類合計],0)) AS 営業外費用, [営業利益]+[営業外収益]-[営業外費用] AS 経常利益, Sum(IIf([損益分類ID]=16,[損益分類合計],0)) AS 特別損失, [経常利益]-[特別損失] AS 税引前当期純利益, Sum(IIf([損益分類ID]=12,[損益分類合計],0)) AS 法人税等, [税引前当期純利益]-[法人税等] AS 当期純利益
FROM Q試算表用Base09_損益分類Gr集計;
SELECT ChrW( 64 + x.num ) As 項目
, Choose(
x.num
, y.項目A金額
, y.項目B金額
, y.項目C金額
, y.項目D金額
, y.項目E金額
, y.項目F金額
, y.項目G金額
, y.項目H金額
, y.項目I金額
, y.項目J金額
, y.項目K金額
, y.項目L金額
, y.項目M金額
, y.項目N金額
, y.項目O金額
, y.項目P金額
) As 金額
, x.num As 順番
FROM t_num x
, クエリ名 y
ORDER BY 3
;
■ ユニオンクエリを使う方法
SELECT 'A' As 項目, 項目A金額 As 金額, 1 As 順番 FROM クエリ名
UNION ALL
SELECT 'B', 項目B金額, 2 FROM クエリ名
UNION ALL
SELECT 'C', 項目C金額, 3 FROM クエリ名
UNION ALL
SELECT 'D', 項目D金額, 4 FROM クエリ名
UNION ALL
SELECT 'E', 項目E金額, 5 FROM クエリ名
UNION ALL
SELECT 'F', 項目F金額, 6 FROM クエリ名
UNION ALL
SELECT 'G', 項目G金額, 7 FROM クエリ名
UNION ALL
SELECT 'H', 項目H金額, 8 FROM クエリ名
UNION ALL
SELECT 'I', 項目I金額, 9 FROM クエリ名
UNION ALL
SELECT 'J', 項目J金額, 10 FROM クエリ名
UNION ALL
SELECT 'K', 項目K金額, 11 FROM クエリ名
UNION ALL
SELECT 'L', 項目L金額, 12 FROM クエリ名
UNION ALL
SELECT 'M', 項目M金額, 13 FROM クエリ名
UNION ALL
SELECT 'N', 項目N金額, 14 FROM クエリ名
UNION ALL
SELECT 'O', 項目O金額, 15 FROM クエリ名
UNION ALL
SELECT 'P', 項目P金額, 16 FROM クエリ名
ORDER BY 3
;
Public Function minifizeTags(s As Variant) As Variant
minifizeTags = s
If Nz(s) = "" Then Exit Function
Dim ary As Variant
ary = Split(s, "<")
Dim i As Long, buf As String, p1 As Long, p2 As Long
For i = 1 To UBound(ary)
buf = ary(i)
p1 = InStr(buf, " ")
p2 = InStr(buf, ">")
If p1 > 0 And p2 > 0 And p1 < p2 Then
ary(i) = Left(buf, p1 - 1) & Mid(buf, p2)
End If
Next
minifizeTags = Join(ary, "<")
End Function
Public Function LAA_Replace(ByVal html As Variant _
, ByVal reg_pattern As String _
, ByVal reg_replace As String) As Variant
LAA_Replace = html
If (LenB(Nz(html)) = 0) Then Exit Function
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.Pattern = reg_pattern
If (.Test(html)) Then
LAA_Replace = .Replace(html, reg_replace)
End If
End With
End Function
■SQL ( 文中のテーブル名は実際の名前に置き換えて下さい )
SELECT ID
, 品番
, 説明文
, LAA_Replace( 説明文, "(<(?:table|t[hd]|span))\s[^>]*(>)", "$1$2" ) as タグ指定置換
, LAA_Replace( 説明文, "(<\w+?)\s[^>]*(>)", "$1$2" ) As タグ無差別置換
FROM テーブル名
ORDER BY 1
;
(4-2）に記載している[Private Sub callExceltable()]のコールプロシージャのままでは
取込み用のエクセル以外を選択したときの判定処理がないため、データの整合性が保てません。
なので 以下の判定用のプロシージャを追記します。
For i = 12 To myLastRow '取込みファイルかを判定する
の行にある12の部分を11に変えます。
エクセルの11行目の項目を判定するためです。
For i = 11 To myLastRow
' '11行目の項目が取り込みのエクセルファイルの形式かを判定する
' '取り込みするエクセルファイルであるか判定するプロシージャー
If i = 11 Then
'
' '11行目が以下の並びの項目があるかを判定する
' '項目名と並び順が違うと取り込みエクセルファイルでないと
' '判断し、以降の処理は行わない
' '+---+----+----+----+----+----+----+----------+
' '|A列|B列 |C列 |D列 |E列 |F列 |G列 | H列 |
' '+---+----+----+----+----+----+----+----------+
' '|No |品番|品名 |数量|単価|金額 |納期|発注者備考 |
' '+---+----+----+----+----+----+----+----------+
'
' '判定を繰り返すカウンター変数
Dim k As Integer
'項目を代入する配列変数
Dim myArrry(8) As String
'ゼロオリジンのため、ゼロから配列変数は始まります
'今回ゼロは使用しないのですが
'分かりやすくするための明示しています
myArrry(0) = ""
myArrry(1) = "No": myArrry(2) = "品番": myArrry(3) = "品名"
myArrry(4) = "数量": myArrry(5) = "単価": myArrry(6) = "金額"
myArrry(7) = "納期": myArrry(8) = "発注者備考"
'8項目分繰り返す
For k = 1 To 8
If myXlWorksheet.Cells(11, k).Value <> myArrry(k) Then
MsgBox ("取り込むエクセルファイルでありませんので処理を終了")
'共通変数に取り込まないエクセルファイルとして
'判別する値を代入する
judgement = -1
'以降の処理をさせない
Exit Sub
End If
Next k
End If
'取り込むエクセルファイルのときは
'名前を取り込み済みを接頭辞として付け加える
If judgement = 0 Then
Dim pos As Long
'[\]の位置を検索
pos = InStr(1, path(1), "\")
'パスを取得する変数
'エクセルファイル名より前の
'パスの文字列を取得
Dim firstCharacter As String
'ルートパスのみの文字列を取得する
firstCharacter = Left(path(1), pos)
'[\]が見つかった場合
If pos > 0 Then
Dim result As String
'[\]の次の文字から最後まで抽出
result = Mid(path(1), pos + 1)
'ファイル名を変える式
'Name oldpathname As newpathname
Name path(1) As firstCharacter & "取り込み済み" & result
End If
End If
'FileDialogオブジェクトを解放する
Set myOrderFile = Nothing
End Sub
SELECT e.noX AS No
, e.partNumber AS 品番
, e.productName AS 品名
, e.quantity AS 数量
, e.UnitPrice AS 単価
, e.totalamount AS 金額
, e.dayOfDelivery AS 納期
, e.remarks AS 発注者備考欄
, e.unionFormatNo AS 管理番号
FROM orderCapture AS e
;
'エクセルファイルをACCESSのテーブルにとりこむための
'コールプロシージャー
Private Sub callExceltable()
On Error Resume Next
'エクセルのアプリケーションをNewキーワードで実体化(インスタンス化)する
Dim myXlApp As Excel.Application
Set myXlApp = New Excel.Application
'エクセルのワークブックを
'共通変数[vrtSelectedItem]で取得した取りこみするエクセルを
'選択してオブジェクトを生成する
Dim myXlWorkbook As Excel.Workbook
Set myXlWorkbook = myXlApp.Workbooks.Open(vrtSelectedItem)
'エクセルのワークシートを生成する
'Sheet1のワークシートを指定して読み込む準備を整える
Dim myXlWorksheet As Excel.Worksheet
Set myXlWorksheet = myXlWorkbook.Sheets("Sheet1") '読み込むシート名を指定
'エクセルの最終行の値を取得する変数
Dim myLastRow As Long
'エクセルシート入力している最終行を取得
'セル番地[A]に入力している最終行を取得して変数へ代入する
myLastRow = myXlWorksheet.Cells(myXlWorksheet.Rows.Count, "A").End(xlUp).Row
'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
'番地は固定
'エクセル番地[A1]の値を代入
myNo = myXlWorksheet.Cells(1, 1).Value
'エクセル番地[H2]の値を代入(発注番号)
myOrderNo = myXlWorksheet.Cells(2, 8).Value
'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
'ADO経由で取り込みテーブルにエクセルデータを転記する
'VBエディターのツールの参照設定で
'microsoft ActivX Data object 6.1llibraryにレ点を入れる
'ADOの接続のオブジェクトの宣言を行う
Dim cn As ADODB.Connection
'ADOのレコードセットの宣言を行う
Dim rs As ADODB.Recordset
'現在のACCESSのテーブルに接続する
Set cn = CurrentProject.Connection
'レコードセットのインスタンスをNewキーワードで生成する
Set rs = New ADODB.Recordset
'取り込みをおこなう[orderCapture]テーブルを開く
rs.Open "orderCapture", cn, adOpenKeyset, adLockOptimistic
'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
'取り込むテーブル[orderCapture]に今回取り込むエクセルデータが
'あるかを照合する
'[コンボBOXの発注者ID]+[受注番号]+[No]を結合した管理番号が
'テーブルに存在すれば、取り込み済みと判断する
'変数を増やしたくないので配列変数で対応する
'unionFormatNo(0)はフォーマットして取り込む文字列を生成する
'[コンボBOXの発注者ID]+[受注番号]+[No]を結合した管理番号
'例：[AA-1111-0001]
Dim unionFormatNo(2) As String
'ForNextステートメントのカウンター変数
'[i]はエクセルのファイルに登録してある件数をカウントする変数
Dim i As Long
'[j]はエクセルファイルを実際に登録した件数をカウント
'すでにあるデータは登録させないアルゴリズムを組んでいるので
'実際の件数をjの変数で取得させる
Dim j As Integer
'初期化しておく
j = 0
'エクセルを取り込みためのボタンをクリックしたときのイベントプロシージャー
Private Sub btn01_Click()
'コンボボックスの値を選択しているかの確認
If Me.cmb01.Value = "" Or IsNull(Me.cmb01) Then
MsgBox ("コンボボックスの値を選択してください")
'コンボボックスにフォーカスを移す
Me.cmb01.SetFocus
'コンボボックスをドロップダウンさせる
Me.cmb01.Dropdown
Exit Sub
End If
'FileDialogオブジェクトを宣言する
Dim myOrderFile As FileDialog
' FileDialogオブジェクトを生成
Set myOrderFile = Application.FileDialog(msoFileDialogOpen)
'開く場所を指定（例：C:\Users\）
'実際はエクセルデータがあるパスを代入する
path(0) = "C:\Users\"
'InitialFileNameプロパティにパスを設定
myOrderFile.InitialFileName = path(0)
'ダイアログのタイトルを設定
myOrderFile.Title = "受注情報を取り込むエクセルファイルを選択してください"
'フィルタを設定（例：エクセルファイル表示）
myOrderFile.Filters.Clear
myOrderFile.Filters.Add "テキストファイル", "*.xlsx"
'慣れるとWithステートメント句で以下の様に省略して記述できる
'With myOrderFile.Filters
'.Clear
'.Add "テキストファイル", "*.xlsx"
'End With
'ダイアログを表示
'-1はOKボタンが押されたことを示す
If myOrderFile.Show = -1 Then
' 選択されたファイルパスを取得
For Each vrtSelectedItem In myOrderFile.SelectedItems
'エクセルファイルのフルパスを代入する
path(1) = vrtSelectedItem
Debug.Print vrtSelectedItem
'ここで選択されたファイルパスを使って取り込みの
'処理を記載する
Open vrtSelectedItem For Input As #1
'ADO経由でエクセルデータを取り込む
'Callプロシージャーでエクセルデータを開き、セルのデータ内容を取得する
Call callExceltable
'ファイルを開くときに使用した変数を閉じる
'閉じる処理をしないとファイルがロックされたままになるので注意
Close #1
Next vrtSelectedItem
Else
' キャンセルボタンが押された場合
MsgBox ("ファイル選択がキャンセルされました。")
End If
Dim pos As Long
'[\]の位置を検索
pos = InStr(1, path(1), "\")
'パスを取得する変数
'エクセルファイル名より前の
'パスの文字列を取得
Dim firstCharacter As String
'ルートパスのみの文字列を取得する
firstCharacter = Left(path(1), pos)
'[\]が見つかった場合
If pos > 0 Then
Dim result As String
'[\]の次の文字から最後まで抽出
result = Mid(path(1), pos + 1)
'ファイル名を変える式
'Name oldpathname As newpathname
Name path(1) As firstCharacter & "取り込み済み" & result
End If
'FileDialogオブジェクトを解放する
Set myOrderFile = Nothing
End Sub
Option Compare Database
Option Explicit
'※事前にVBエディターのツルーバーにある「ツール」をクリックして
'[参照設定]のメニューを開き
'参照可能なライブラリーから
'[Microsoft Office 16.0 Object Library]にレ点のチエックを入れる
'これをしないとファイルダイアログボックスは開かれるエラーになる
'パスを指定する
'VBエディターのツールバーにある
'「ツール」の参照設定から
'「Microsoft Excel XX.X Object Library」
'にレ点をいれる XX.Xは各PCのバージョンに合わす
'コマンドボタンをクリックするイベントプロシージャーから
'取得した変数データをCALLプロシージャーへ渡すため
'共通変数としてここに宣言する
'ダイアログBOXで開く場所のパスを代入する変数と
'ファイル名を変更するときにファイルパスを取得する変数の
'2つの変数を代入させるため配列変数で宣言
Dim path(2) As String
'エクセルのファイルを指定したパスを代入する変数
Dim vrtSelectedItem As Variant
'エクセル番地[A1]の値を代入
Dim myNo As Long
'エクセル番地[H2]の値を代入
Dim myOrderNo As Long
'セル番地[A11]の[No]の値を保有させる変数
Dim cells_No As Long
’ここまでが共通変数を宣言した部分となります
このクエリデータを変形しようとしているのですね。
このクエリのソース自体も名称からして集計クエリのようですね。
集計クエリをもとにクエリを作成するという設計は重い処理になりがちです。
メモリ消費も多くなりそうです。
また、このクエリは縦並びのもの(正規化された形)を横並びになるように変形するものですね。
で、質問でやろうとしていることは、この横並びのものを再び縦並びに戻すということですね。
縦のものを横にして、再び縦に戻すという無駄なことをしているように思えます。
大元のテーブルが正規化されたものなら、そこから直接希望の結果データを得るクエリを考えた方が軽い処理になりそうです。
方法としては大きく２つあります
【 1 】
t_num テーブルに従属列を作り、2列構成にします
SQL文では ChrW関数の使用箇所を
とテーブルの従属列への参照に置き換えるのが王道と言えるでしょう
個々のデータをテーブルというオブジェクトを使って「可視化」できるメリットが大きいため
私としては、こちらの方法をお薦めします
【 2 】
t_num テーブルは1列構成のままにしておき、SQL文中に文字リテラルを直に埋め込んでもいいでしょう
( お薦めはしませんが )
【 1 】の方法で実装したSQL
【 2 】の方法で実装したSQL
mayuさん ありがとうございます。
やはり全角スペースが入ってた様です。それを注意深く修正したら出来ました。
金額算出の指摘もありがとうございました（確かに間違ってました）。
この素晴らしいＳＱＬは半分も理解できてないのですが（すみません）、コードのままだと項目がＡ、Ｂ・・・になってます（多分ChrWの兼ね合いですね）。それを元データのフィールド名の”期首在庫” ”仕入高” 等にするにはどうすればいいでしょうか？ それと各金額を通貨型にするにはどうしたらいいでしょうか？（現在は文字列型になっているので）
Q試算表用Base10_損益各利益 クエリには 18列 あるわけですから
t_num のテーブルデータは、１～ 16 ではなく、1 ～ 18 になっていますか
また、>> 6のSQL文中に全角空白が含まれていますから、全て半角に修正して下さい
SQL文の句間を区切る空白に全角は使えません
それと
損益分類ID 12 は勘定科目が重複していますから、当期純利益の値が正確ではないように思えます
mayuさん ありがとうございます。
もう一つの方法で下記ＳＱＬ実行させると クエリ式エラー , Choose( *** ’の構文エラー：演算子がありませんとなります。何か間違えてます？
hetenaさん ありがとうございます。
現行ﾃﾞｰﾀはACCESS作成分で下記ＳＱＬとなってます。（最終的に18項目となりました）
FROMのクエリは集計クエリで分類毎の合計金額を出してます。その各合計金額を上記で更に色々計算させています（それで１行のデータになってます）。それを後々扱い易い様に縦並びにしたいのです。
この１行のデータの形がよくないでしょうか？
クエリの列数は 16 ということでしたが、実際は 16 列以上だったりしないでしょうか
あまりに縦結合する回数が多かったり、
演算フィールドの値に定義域集計関数を使っていたりすると、リソース不足になることも十分ありえます
また、>> 1の回答で補助テーブルを使う方法も紹介していますが、こちらの結果はどうだったのでしょうか
ユニオンクエリより軽い( クエリのデータスキャンが一回で済みます )ので
メモリ不足のエラーが発生するとは考えにくいです
16の演算フィールドは 全て同じ計算方法 で算出していますか
浮動小数点が含まれる列・含まない列があったり、列毎に使用する関数が異なっているなど
データ型が混在してたりはしないでしょうか混在する場合は、結合の際に CCur関数などで演算フィールドのデータ型を統一する必要があるでしょう
UNION ALL句を5回内包した単体のユニオンクエリを 3 ～ 4つ作り
単体のユニオンクエリ同士を、再度 UNION ALL で結合したということでしょうか
もし、そうであるなら 単体のクエリで利用するリソースが多すぎるということです
先に述べたように、補助テーブルを使う方法が妥当でしょう
このデータはAccessで作成したものでしょうか。
それとも外部から取り込んだものでしょうか。
どちらにしてもリレーショナルデータベースとしてはNGなテーブル設計です。
Accessで作成したものならテーブル設計を欲しい結果の形(正規形)になるようにし直しましょう。
外部から取り込んだものなら取り込むときに正規形のテーブルに変換して取り込むようにしましょう。
取り込むときに変換する方法はいろいろありますが、mayuさんの回答のクエリで正規形に変換して追加クエリで追加するのもひとつの方法です。
mayuさん ありがとうございます。
ユニオンクエリで試しまた。それでいけたのですが全項目だと”メモリ不足”や”これ以上テーブルは無理”のメッセージが出ます。５ヶ位づつのユニオンだといけます。ベースの各項目が計算でして出したものだからでしょうか？
２通りの方法を載せておきます
■ 1 ～ 16 までの数値を入力した補助テーブルを使う方法
・DDL・テーブルデータ・DML( 文中の クエリ名 及び 項目XXX金額 は実際の名前に変更して下さい )■ ユニオンクエリを使う方法
「 HTML テキスト内の全ての要素から全ての属性を取り除く」というのが主な目的なのであれば、
「DOM オブジェクトを使用する」という方法も一応は考えられますが、
上記のようなテキストを DOM オブジェクトで扱う場合は、以下の点に留意しなければならないでしょう。
<html>など最上位のタグで囲まれている状態でパースさせる必要がある。パースされた結果として各行にはインデントが自動的に挿入、調整される。
mayuさんから回答があるようにユーザー定義関数を作成することになると思います。
MSはVBScriptは将来的に廃止にする意向のようですのでVBScriptに依存しないものを作成してみました。
置換対象が「文字列」ではなく「ルール」ですから、VBA.Replace関数での実装は難しいでしょう
別案として 正規表現のUDFを利用する方法をご紹介します
■ユーザー定義関数
■SQL ( 文中のテーブル名は実際の名前に置き換えて下さい )
なお、正規表現に馴染みが無い場合は chatGPT あたりを利用し、AI に
というメッセージを送ってみたり、Grok に
とでも尋ねてみると、それなりの例やマニュアルを提示してくれるでしょう
「フォント」「dpi」あたりで検索すると幸せになれるかもしれません
※詳しく調べていませんが、リモートデスクトップで接続した時のみ現象が出る可能性があります。
三つ並んでいるのはフォントサイズ左から10,9,8です。
色々間違いがあったので訂正します。
・テキストボックスではなくラベルで、自動調整はラベルを右クリック＞サイズ変更の自動調整の事です。
・windowsのバージョンは関係ありませんでした。
スクリーンショット用にサンプル作成時に気付いたのですが、モニターのサイズの影響の様です。
４Kモニター＋FullHDモニターのPCで作成したものをFullHDモニターのPCで表示すると再現する事がわかりました。
右がFullHDモニターのPCで、下段はテキストボックスでフォントサイズ8、ラベルと幅を合わせたものです。
お手数おかけしました。
どのオブジェクト（フォーム/レポート）についての話をしているのか。
レポートについての話である場合、「印刷プレビュー（またはレポートビュー）で開いた際の表示内容」と「用紙への印刷結果」のどちらについての問題なのか。
とりあえず、以上の点について具体的に明記されることをお奨めします。
もし可能であれば、その状態が一目で判るようなスクリーンショットを添付されるとよいでしょう。
回答者が不具合を再現できるように、もう少し詳しく状況を説明するのはどうでしょう？
とりあえず、Windows11でテキストボックスの設定を調整し直すのはどうでしょう？
エラー行を全て削除し、更新クエリを実行したら、きちんと行えました。
誠にありがとうございました。
再びのご指摘ありがとうございます。
全てのレコードについて見直しましたら、ありました、ありました。
ご指摘の2番目、11文字目以降に"-"が含まれていない注文番号のデータがありました。
私の式が適切ではなく、条件に合致しないものがありました。
sk様、今回はご丁寧な解説ありがとうございました。
大変勉強になりました。
また、よろしくお願いいたします。
演算フィールド[発注番号]が Null を返している場合については問題ないはずです。
hiroton さんと私が指摘しているのは、[発注番号]が以下のような結果を返しているレコードが
[Q_手配内訳2]に 1 件以上含まれていないか、ということです。
[注文番号]の値が Null である（結果、Left 関数の第 2 引数に Null が渡されてエラーが発生する）。
[注文番号]の値の最初の 1 文字が "B" ではなく、かつ 11 文字目以降に "-" が含まれていない（結果、Left 関数の第 2 引数に -1 が渡されてエラーが発生する）。
[注文番号]の値の最初の 1 文字が "B" であり、かつ 12 文字目以降に "-" が含まれていない（結果、Mid 関数の第 3 引数に -2 が渡されてエラーが発生する）。
上記のケースに該当する場合に、エラー値が返されないように[発注番号]の式を組み直すか、[注文番号]の値を適切なものに書き換えるか、もしくは該当するレコード自体が[Q_手配内訳2]の結果に含まれないようになされば、[Q_手配内訳2]と[T_指定日インポート]を[発注番号]同士で結合できるようになるでしょう。
上記の投稿は私です。名前入れるの忘れました。
sk様
的確なご指摘ありがとうございます。
確かに "-" が見つからなかった場合の扱いは設定されておらず、結果演算フィールドは空のままです。
私はこれがエラーと認識できていなかったのが現実です。
選択クエリでデータシートが表示されていたので、大丈夫なものと思い込んでいました。
ある特定のフォーマットの注文番号だけ処理できていればそれでよかったので、浅はかでした。
今回は大変勉強になりました。
全ての条件でデータを発生させることができない演算フィールドの扱いには注意したいと思います。
皆さま、ご回答ありがとうございました。
処理内容が長いのキャプチャ画面を添付します。
コードが長いので、2つの画面となります。 一部重複しております。
(4-2）に記載している[Private Sub callExceltable()]のコールプロシージャのままでは
取込み用のエクセル以外を選択したときの判定処理がないため、データの整合性が保てません。
なので 以下の判定用のプロシージャを追記します。
の行にある12の部分を11に変えます。
エクセルの11行目の項目を判定するためです。
また [judgement]の変数は共通変数として使用するため
投稿している（1）のプログラムの最終行に判定する変数を宣言します
そして投稿（3）のプロシージャに[judgement]変数に代入した
判定値をもとに、エクセルのファイル名を変更するかの条件分岐を行います
名前を変更するプログラムの場所を以下に書き換えます。
ソースコードが長いので変更箇所が分かりづらく恐縮ですが
エクセルファイルが取込み対象かを判定する処理は盛り込んでいた方が
大勢の人が取込み処理する場合には有用であるといえます。
また取込みフォルダを固定化して、取込みたいエクセルファイルを
指定したフォルダに入れておき、取込み後、取込み済みフォルダへ
移動する方法もあります。 この方法であれば、ファイルを1個毎に
選ばず一括処理できるので業務は楽になります。
FileSystemObjectを活用してフォルダ内のファイルを開いて
取込み処理を行うソースコードを記述して運用しております。
余談ですがEOS受信と呼ばれる方法であれば、取込みするファイルにはヘッダーとフッターとよばれる
取込み判定する行があり、データを取り込む場合はヘッダーとフッターを読み込み
取込みデータかを判定してから織り込み開始を行います。
テーブル名は英語表記の方が無難です
ACCESSの更新プログラムで日本語表記のソースコードは
不具合が起きる事例がありますので、日本語をやめて
ローマ字表記もしくは、英語表記がいいです。
SQL文にてカラム名（フィールド名）は別名で修飾できます。
AS句の後に日本語表記のカラム名（フィールド名）を付与します。
また、テーブルAS句にて別名を付けた方がいいでしょう。
カラム名(フィールド名)にテーブル名で修飾するときも
テーブル名を簡素な別名を付与することで、カラム(フィールド名)の
修飾がたやすくなるのと、可読性があがります。
またカラム(フィールド名)を修飾するには理由があります。
それは、データベースの検索を早くするのと、データを探すために
ハードディスクのオーバヘッドを軽減するためです。
ここらあたりは小難しい話になるの省略しますが、
SQL文にて別名をつけることは、セキュリティの観点からも
望ましいため、テーブルの設計時において、このことを念頭に
設計してみてください。
あとハンドルネームが無いとやり取りしづらいので
ハンドルネームの記入をお願いします。
ここの回答者は親切な方ばかりなので
ハンドルネームがあったほうが、回答されやすくなりますし
固定のハンドルネームであったほうが、こないだ質問された方だなと
すぐわかるので、回答が付きやくなると思います。
かなり長いコードとなりますが、おおむねこれで質問者さんが質問に書かれていた
エクセルの発注書に登録されているセル番地からデータを取得して転記することができます。
処理を実現するためには、ポイントとして
「Microsoft Excel XX.X Object Library」を
参照設定にて使用できるように設定をおこなう。
これは、エクセルファイルをアクセス側から読み書きできように
するための処理です。このツールを設定することを知らないと
アクセスからエクセルを自在に扱えないので、ここでつまずきます。
そして次のポイントとして、アクセスのVBAだけでは実現できない処理を
参照設定にて「microsoft ActivX Data object 6.1 Library」を使用
出来るようにしてADOを使えるようにすることです。これにより
アクセス以外のSQLServerやオラクルなどのデータベースなどと
接続することができます。
これによりADOにおけるテーブルの更新処理なども柔軟におこなえるようになります。
なによりVBAのコード内でADOの機能を利用してVBAだけでは不可能な処理を可能とします。
外部参照設定をおこなうことにより、他のソフトなどの機能をアクセス内に
取り込めます。
大まかにまとめると
（1）「Microsoft Excel XX.X Object Library」
（2）「microsoft ActivX Data object 6.1 Library」
参照設定にて(1)(2)の機能を取り込むことにより今回の
質問内容の処理を実行することが可能となるのです。
追記ですが(3)のソースコードに
取込み後にエクセルファイル名に「取り込み済」の文字を付加した
構文も載せています。
Nameステートメントでファイル名を書き換えております。
（4-3）メモリーの解放をおこなう処理となります
これでソースコードは終了となります。
アクセスのテーブルに取り込んだサンプルデータ
（4-2）実際に処理する部分となります
（4-1）長いので(4-1)と(4-2)（4-3）に分割して投稿します
※4-1）の部分は変数の宣言部分となります
(3)コマンドボタンを押したときの処理です
ここからが本題となります。
（2）フォームに挿入したコンボBOXのイベントプロシージャです
コンボBOX名は[cmb01]です
コードが多いので分割して投稿します
分かりやすくすために番号を振っておきます
（1）VBAのコードのOption Compare Database、Option Explicit
が記載されている上部に記載するコードです。
フォーム内で共通で使用する共通変数をこの領域に記載します
とりあえず作成したソースコードを記載します。
SQLのCREATE TABLE文で作成したアクセスファイルに
フォームを作成してコマンドボタンを1個配置して
以下のソースコードを貼付けください
コンボBOX名はcmb01
テキストボックス名は、txb_発注者
コマンドボタン名は、btn01
コンボBOXに登録するテーブルも作成します
テーブル名はtb
フィールド名は2項目
フィールド名 ID、オートナンバー型
フィールド名 フィールド1 短いテキスト
集合値ソース:SELECT tb.ID, tb.[フィールド1] FROM tb;
これらの設定を行ったフォームがあれば、あとは取込みたい
エクセルを用意すれば、取込みができます。
サンプルのソースコードをテーブルを作成して見てください。
質疑応答時に双方でテーブル名、カラム名などが違いと意思疎通が
うまくいきませんので共通のテーブルでサンプルコードを実行する方が
効率よく質問事項が解決します。
質問者さんの内容はかなり複雑でありますが、コードを日常から作成していると
そんなには難しくありません。ただし、アクセスのVBAだけでは実現しませんので
ADOなどの技術を活用して質問者さんが行いたい事は可能となります。
とりあえず、アクセスのVBエディターにてADOを使用できる設定をおこなってください。
設定方法は以下のソースコードに記載しております。
適当にアクセスのファイルを作成してください
そして、フォームを作成してコマンドボタンのクリック時の
イベントに以下のコードを張り付けて、ボタンをおしてみてください
サンプルテーブルが自動で作成されます。
※事前にVBエディターのツールの参照設定に
microsoft ActivX Data object 6.1 Libraryにレ点を入れておいてください。
とりあえず、コンボBOXの値をテキストボックスに反映するには
コンボBOXの.Column()で値を取得します。
.Column()のカッコのなかはゼロオリジンで指定しますので
コンボBOXの値の1列目を取得するばあいは.Column(0)
2つ目を取得する場合は.Column(1)とします。
またコンボBOXをテキストボックスに代入するのはいいのですが
テキストボックスなので値を間違って書き換えられるおそれがあります。
なので、ラベルに記載したほうが無難です。どうしてもテキストボックスに
転記、および値を書き換えられないようにするには、EnabledプロパティをFalseにして
書き換え不可にします。 値を取得するときはEnabledプロパティをTrueにして
代入後にFalseにするプログラムを書きます。
sk様
お世話になっております。
Connect プロパティの値をイミディエイトウィンドウで確認したところ
きちんとパスワードも設定されておりました。ACCESS RunTimeしか入っていない
PCで動作確認したとこと正常に動作しました。
ご指導していただき、安心して本番環境で問題なく運用できます。
今後ともよろしくお願いいたします。
これにてこのスレッドは解決とさせていただきます。
以上
世の中のExcel発注書はそうならないように会社名など雛形になっているんですよ。
そりゃそうですよ。工夫してセル結合するだけでしょ。
うーん、Excelで出来ないことをAccessで出来るわけないんですよ。丸投げ質問は他の回答者でも難しいんじゃないかしら？