Public Sub Sample()
Const ExcelFileName = "C:\test\Tbl1.xlsx"
DoCmd.TransferSpreadsheet acExport, 10, "Tbl1", ExcelFileName, True
Dim objExcel As Object, objWb As Object, objWs As Object
Set objExcel = CreateObject("Excel.Application")
Set objWb = objExcel.Workbooks.Open(ExcelFileName)
Set objWs = objWb.Worksheets(1)
objWs.cells.Font.Size = 10
objWb.Save
objWb.Close
objExcel.Quit
Set objExcel = Nothing
End Sub
Sub 単価転送()
Dim DBpath As String
Dim adoCn As Object
Dim strSQL As String
Dim henDB As String
Dim i As Long
Dim ws_2 As Worksheet
Set ws_2 = Worksheets("転送用シート")
henDB = Worksheets("Sheet1").Range("D1")
Set adoCn = CreateObject("ADODB.Connection")
DBpath = ThisWorkbook.Path & henDB ' パスを確認
adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & ";"
With ws_2
i = 2
Do Until .Cells(i, "K") = ""
strSQL = "UPDATE Q_単価更新用 SET 仕入=" & .Cells(i, "I") & " WHERE 更新合成キー ='" & .Cells(i, "K").Value & "'"
'// ここを調査用のコードに書き換える
' adoCn.Execute strSQL
Dim RecordsAffected As Long
adoCn.Execute strSQL, RecordsAffected
If RecordsAffected = 0 Then
Debug.Print strSQL
Stop
End If
'//ここまで
i = i + 1
Loop
End With
adoCn.Close
Set adoCn = Nothing
End Sub
RecordsAffected
省略可能です。 この操作の影響を受けたレコード数をプロバイダーが返す長整数型 ( Long ) の値です。
>>途中のデータ行の K 列の値が Empty 値 / 空文字列 であるため、全てのデータ行を網羅し切る前にループ処理が終了している。
For～Nextで検証しましたが、更新されませんでした。
I列は、
Sub 単価()
Dim ws_2 As Worksheet
Set ws_2 = Worksheets("転送用シート")
maxR = Cells(Rows.Count, "A").End(xlUp).Row
maxR2 = ws_2.Cells(Rows.Count, "A").End(xlUp).Row
hajimeGyo = ActiveCell.Row
hajimeRetu = ActiveCell.Column
Range(Cells(hajimeGyo + 1, hajimeRetu), Cells(maxR, ActiveCell.Column)).Copy
ws_2.Cells(2, "I").PasteSpecial xlPasteValues
For i = 2 To maxR2
If ws_2.Cells(i, "I") = "" Then
ws_2.Cells(i, "I") = 0
End If
Next i
End Sub
Sub UpdatePrices()
Dim wsSource As Worksheet
Dim lngFirstRow As Long
Dim lngLastRow As Long
Set wsSource = Worksheets("転送用シート")
With wsSource
lngFirstRow = 2
lngLastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
If lngFirstRow > lngLastRow Then
Debug.Print "ワークシート[" & wsSource & "]にデータ行がありません。"
Set wsSource = Nothing
Exit Sub
End If
End With
Dim adoCn As Object 'ADODB.Connection
Dim strDbName As String
Dim strTargetPath As String
Set adoCn = CreateObject("ADODB.Connection")
strDbName = Worksheets("Sheet1").Range("D1")
strTargetPath = ThisWorkbook.Path & strDbName
Debug.Print strTargetPath
adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strTargetPath & ";"
Dim adoCmd As Object 'ADODB.Command
Dim strSQL As String
Set adoCmd = CreateObject("ADODB.Command")
With adoCmd
Set .ActiveConnection = adoCn
.CommandType = 1 'adCmdText
strSQL = "PARAMETERS [SearchKey] TEXT(255), [UpdateValue] INT;" & vbCrLf & _
"UPDATE [Q_単価更新用] AS q1" & _
" SET q1.[仕入]=[UpdateValue]" & _
" WHERE q1.[更新合成キー]=[SearchKey];"
Debug.Print strSQL
.CommandText = strSQL
.Parameters.Append .CreateParameter("SearchKey", 202, 1, 255) 'adVarWChar, adParamInput
.Parameters.Append .CreateParameter("UpdateValue", 3, 1) 'adInteger, adParamInput
End With
Dim lngRow As Long
Dim lngRecordAffected As Long
Dim lngAffectedTotal As Long
Dim rngKeyCell As Range
Dim rngValueCell As Range
lngAffectedTotal = 0
For lngRow = lngFirstRow To lngLastRow
Set rngKeyCell = wsSource.Cells(lngRow, "K")
Set rngValueCell = wsSource.Cells(lngRow, "I")
lngRecordAffected = 0
If (rngKeyCell.Value <> "") And (IsNumeric(rngValueCell.Value) = True) Then
adoCmd.Parameters("SearchKey").Value = rngKeyCell.Value
adoCmd.Parameters("UpdateValue").Value = CLng(rngValueCell.Value)
adoCmd.Execute lngRecordAffected
End If
If lngRecordAffected = 0 Then
Debug.Print lngRow & "行目のデータは更新対象になりませんでした。"
Debug.Print vbTab & rngKeyCell.Address(False, False) & "セルの値: " & rngKeyCell.Value
Debug.Print vbTab & rngValueCell.Address(False, False) & "セルの値: " & rngValueCell.Value
ElseIf lngRecordAffected > 1 Then
Debug.Print lngRow & "行目の更新合成キー（" & rngKeyCell.Value & "）に該当するレコードが " & _
lngRecordAffected & " 件更新されました｡"
End If
lngAffectedTotal = lngAffectedTotal + lngRecordAffected
Set rngKeyCell = Nothing
Set rngValueCell = Nothing
Next
Set adoCmd = Nothing
adoCn.Close
Set adoCn = Nothing
Debug.Print "全部で " & lngAffectedTotal & " 件のレコードが更新されました。"
End Sub
Private Sub レポートヘッダー_Format(Cancel As Integer, FormatCount As Integer)
Me!部数表示 = Me.OpenArgs
End Sub
印刷ボタンのイベントを次の通りにします
Private Sub cmdPrint_Click()
Const DocName = "T_ケースマーク印刷データ（Tag Noあり） のコピー"
Dim i As Long
DoCmd.Close acReport, DocName '部数表示設定のために閉じる
For i = 1 To Me!印刷部数
DoCmd.OpenReport DocName, acViewNormal, , , , i
Next
End Sub
hatena様
返信遅れて申し訳ありません。
仰る通り、下記のSQL文で解決しました。
回答ありがとうございました。
確認ですが、
複数フィールドに主キーを設定しているのですか。
オートナンバーは重複しないので意味がないのでは？
ID(オートナンバー型)を主キーにして、合成キーはインデックス(重複なし)を設定するのが通常の設計だと思います。
また、追加クエリーにはオートナンバー型フィールドは含めないようにすべきだと思います。
hatenaさん ありがとうございます（連絡遅くなり失礼しました）。
フォーム再作しても状況変わらずでしたので、リレーションを見直しました。メインテーブルの顧客IDに色々設定しているのが間違えてました。顧客テーブルにするのが正解でした。メインフォームの入力用コンボボックスに対してリレーションしてしまってました。リレーションとルックアップを同じ様に考えてました。
正しく設定すると普通にレコード削除できました。
お世話になりました。
sk様
図まで添付していただきありがとうございます。
テーブルに関しては、その通りです。
クエリで00-0000-00-202410な文字列をExcelでもACCESSでも作成しています。
返信遅くなりまして申し訳ありません
ご丁寧な対応ありがとうございました。
わたくしのスキルでは1行ずつ解析する必要がありますので、これから取り組んでみます。
下記のサンプルコードでうまくいくことを確認しました。
エクスポートしたブックを、VBAで開いてフォントを変更するしかないような気がします。
Accessからエクセルを開いて操作する方法は下記あたりを参考に。
【Access VBA】AccessからExcelを操作する方法 #ポートフォリオ - Qiita
つまり、
Access 側の[MT_検索テーブル]の各レコードの更新前の状態がこうであるのに対し、
Excel 側の[転送用シート]（恐らく実際は別のワークシート）の状態がこうだとして、
そのブックのいずれかのワークシートの「任意の日付が入力されているセル」が
選択されている（アクティブセルになっている）状態でマクロを実行したら
Access 側の[MT_検索テーブル]の各レコードがこうなればよい、ということですか。
言われてみれば、exit sub(function)がなければ終了していないので、
下部のerrTrapの処理が行われてしまいますね。
変数を多用するケースではないので、
いちいちfunctionに飛ばすのも面倒だと思って飛ばさないようにしていたのですが、
途中で終了させるわけにはいかないので、
目障りではありますが、飛ばして処理する事に致します。
ありがとうございました。
そのフォームが破損しているのかもしれません。
一からメインフォームとサブフォームを作り直してみたらどうでなりますか。
hiroton様
貴重なご意見ありがとうございました。
＞＞問題解決のために何が必要か？複数のアプローチを検討・実施することが問題解決の近道になります
その通りだと思います。
今後に向けて精進します。
回答し辛い質問ですが・・・
プログラムは上から下に順番に実行されていきますので、
正常にレコードが更新されてからerrTrap:に飛んでいるのではなく、
更新後にerrTrap:移行の処理が順番に実行されています。
試してませんが、errTrap:の前でexit sub(function)で処理を抜けるようにすればいいはずです。
hirotonの回答は「実際に実行されたSQLを表示する」だけです
続く条件判定により「『更新されない』時だけSQLが表示される」ことを期待しています
結果を見てできることを質問者さんが考えてもいいですし、そのまま結果を提示してもらえれば問題解決に一歩近づくだろうという検証をするための情報を生み出すコードです
このコードの実行結果はいくつか想定されます。たとえば
Stop行が実行され（処理が中断し）、SQLが表示された大きく分ければこの二つしかありませんが、SQLが表示されれば
のように、内容を深堀することもできます。当然、「SQLが表示されることなく処理が終了した」の結果ならその先の想定も無意味なものになるので、hirotonの最初のアプローチとしては「実際に実行されたSQLを確認してみては？」で止まっているわけです
回答で想定されているパターンを網羅するのは質問に対して不要な情報であふれることになりトピックの質が落ちますし、１つの正解以外は徒労というのもhirotonはやりたくありません
自己解決した内容をみるに、実行されるSQLは期待した文字列だったものと思われます。SQLが正しく実行されるかどうかのほうに問題があり、つまり、EXCELからの読み込み部分は問題ないのだと確認が取れるでしょう
ならば、EXCELのデータやその取り込み部分をいくら深堀したところで問題は解決しません
問題解決のために何が必要か？複数のアプローチを検討・実施することが問題解決の近道になります
クエリでは、更新できませんでしたが、テーブルに変更すると、更新ができました。
理由は不明です。
sk様 いつもありがとうございます。私の不手際で、気分を害されたら、お詫びします。
また、検証用のコードありがとうございました。
このようなコードで、検証できるように、精進します。
hiroton様
いつも回答ありがとうございます。
hiroton様の検証用のコードも理解できませんでしたので、理解できるように精進します。
お騒がせして申し訳ありません。
ありがとうございました。
hirotonさん
出来ました！
ありがとうございます、本当に助かりました！！
sk様返信ありがとうございます。
＞＞Access側のテーブル[MT_検索テーブル]のフィールド[直近3ヶ月]のデータ型は日付/時刻型なのでしょうか。
日付/時刻型です。
>>Excel 側のワークシート[転送用シート]において、K 列の各セルは J 列を含む他の列のセルを参照する数式セルなのでしょうか。
>>
また、[仕入コード]、[油種コード]および[単価_ランク_コード]に相当する列は、Excel 側のワークシート[転送用シート]に存在していないのでしょうか。
存在しています。
Cells(i, "A")⇒仕入コード
Cells(i, "E")⇒油種コード
Cells(i, "G")⇒単価ランクコード
Cells(i, "J")⇒日付コード
です
Access側のテーブル[MT_検索テーブル]のフィールド[直近3ヶ月]のデータ型は日付/時刻型なのでしょうか。
Excel 側のワークシート[転送用シート]において、K 列の各セルは J 列を含む他の列のセルを参照する数式セルなのでしょうか。
また、[仕入コード]、[油種コード]および[単価_ランク_コード]に相当する列は、Excel 側のワークシート[転送用シート]に存在していないのでしょうか。
ならば、そのように実行できるように手順を示すべきでしょう
自分の思うとおりに動いてくれなかったことの責任を相手に求めるのは良くないですよ
これは質問者であるとか回答者であるとかに関係することではありません
続く文に関しては特にhirotonが指摘している件とは無関係なのでノーコメントです
更新を実行したいクエリのSQL文は、下記の通りです。
仕入のフィールドの型は、
単精度浮動小数点型です。
昨日からのアドヴァイスをいただき、検証しました。
実際に利用している単価更新キーは
00-0000-00-202410
このような文字列です。
SQL文に記載のある
この値をつけると更新できませんが、この値をつけなければ更新できます。
00-0000-00 ⇒更新できます。
sk様のコードでも確認して、更新件数は合致します。
Excel上のマクロは下記の通りです。
疑問なのですが、
このコードを実行すると、202410になりますが、ExcelとACCESSでは、異なる値と判断されるのでしょうか？
単価転送とは別のデバッグ用マクロとして示したものですので、そっくりそのままコピーして実行していただかないとむしろ困ります。少なくとも、実際に更新されたレコード件数が本当に 3 件であるならば、イミディエイトウィンドウにもそのように示されるはずであり、挙動としてあまりに不自然です。
もともと「
Sub 単価転送()」とプロシージャを設定しているのにそっくりそのままコピーして実行したのではないからだというのはちょっと酷だと思いますよSQLを実行している部分を書き換えます
ヘルプによれば
RecordsAffectedにUPDATEで更新されたレコード数が入るはずなので、期待通り更新されれば「1」、更新されなければ「0」となっているはずなので、「0」の時だけイミディエイトウィンドウにstrSQLの値を書き出し、つづくStop行でVBAの実行が中断されますまたは、
Stop行は記述せずに、iの値と合わせてすべて処理させてから確認してもいいでしょうイミディエイトウィンドウの表示は100行までなので、「うまく更新されないデータ」が100件を超える場合は注意してください
それは私の例示したマクロをそっくりそのままコピーして実行したのではなく、ご自身が作成されたマクロを部分的に修正されたものを実行されたからではないでしょうか。
例えば、Execute メソッドの呼び出し時に引数 RecordAffected に Long 型の変数（ lngRecordAffected ）を渡していない、RecordAffected を介して取得した更新件数を別の Long 型の変数（ lngAffectedTotal ）に累計加算する処理を記述していない等。
比較/更新対象となるのはあくまで Access 側のテーブル/フィールドですので、Excel ワークシート側のデータのみを検証しても正確なことは判らないでしょう。
その部分だけを示されても、検証用のクエリが適切に作られているかどうか評価のしようがありません。
また[Q_単価更新用]という名前から推察した限り、UPDATE 文において呼び出されているのはテーブルではなく選択クエリのように見えますが、もし[Q_単価更新用]が選択クエリであるならば、それが具体的にどのようなクエリであるか、実際に更新対象となるのはどのテーブルであるか、そのテーブルの各フィールド（特に[更新合成キー]）はどのように定義されているのか、といったことも検討すべき問題となります。
[Q_単価更新用]がテーブルではなく選択クエリであるならば、とりあえずそのクエリの SQL ビューの内容をそのまま明示して下さい。
Access 側のテーブルにおけるフィールド[仕入]のフィールドサイズ（十進型である場合は[精度]および[小数点以下保持桁数]プロパティ）はどのように設定されているのでしょうか。
hiroton様
コード提示ありがとうございます。
私、ヘルプも読んだのですが、理解ができません。
このコードは、どこに差し込むのでしょうか？
また独立で、作動させるのでしょうか？
お手すきの時に回答いただけたら幸いです。
よろしくお願いいたします。
実際に実行されたSQLを確認してみては？
Execute メソッド (ADO Connection)
「現在部数 / 最大部数」で表記する方法はいくつかあると思いますが、そのまま単純にその形でテキストを流しこめばいいでしょう
とりあえず、テストしたサンプルの画像を貼っておきます
すいません
間違えました。
I列は、少数点の数値です。
152.2などです
×2024/10/1を202410に変更しています⇒間違えました
>>途中のデータ行の K 列の値が Empty 値 / 空文字列 であるため、全てのデータ行を網羅し切る前にループ処理が終了している。
For～Nextで検証しましたが、更新されませんでした。
I列は、
このようになコードです
2024/10/1を202410に変更しています。
一応、ACCESSのクエリ上で確認しました。
〇の判定は、184個あり、私の認識では、184個更新されると思うのですが、そんな単純な話ではないのでしょうか？
sk様
更新結果は、イミディエイトウィンドウでは、０件でしたが、実際は、３件更新されました
一例ですが、
ACCESS上の更新合成キー 126-1200-30-202410
Excel上の更新合成キー 126-1200-30-202410
目検で同じように見えますし、EXACT関数で確認しても、Trueとなり、同じように見えます。
これがなぜ更新できないのかが、わからないでです。
sk様 いつもありがとうございます。
更新結果は、０件でした。
更新合成キーが存在しないんですね。
hirotonさん
ありがとうございます。
設定してやってみたのですが、私の技術不足のせいか、うまくいきませんでした・・・
また、投稿説明不足もあったと思い、追加説明をさせて下さい。
下記フォームで、部数に印刷したい枚数を入力して、隣のNo.あり・なしが印刷ボタンになっていまして
画像1
印刷ボタンを押すと下記が指定枚数分印刷されるようになっています。
画像1
印刷画面の右上に、例えば印刷したい枚数が10枚ならフォームの部数に10を入力すると
1枚目 1/10 2枚目 2/10 3枚目3/10・・・という風に印刷したいです。
すみません、よろしくお願いします。m(__)m
途中のデータ行の K 列の値が Empty 値 / 空文字列 であるため、全てのデータ行を網羅し切る前にループ処理が終了している。
途中のデータ行の I 列の値が数値（もしくは数値データに変換可能な文字列）ではないため、SET 句の右辺が抜けて構文エラーが発生している。
単純に、フィールドの[更新合成キー]の値が K 列の値と一致するレコードが[Q_単価更新用]側に存在していない。
以前ご質問された件を踏まえると、恐らく 3 である可能性の方が高いのではないかと推察します。
とりあえず、以上のマクロを実行してみて
イミディエイトウィンドウに出力された結果を
確認してみて下さい。
まずは確認ですが、
部数印字
こんな感じのことを通常のプリンタでやりたいってことでいいですか？
印刷するごとに印刷内容が変わるので、必要回数（部数分）印刷を繰り返します
印刷の実行時に
DoCmd.OpenReportなら追加の情報を付与できるので、レポート側でその情報を使って印刷内容を変えます印刷するレポート「T_ケースマーク印刷データ（Tag Noあり） のコピー」（以下単にレポート）に部数表示用のテキストボックス（名前：部数表示）を配置します
レポートにレポートヘッダーを設定して（可視プロパティ「いいえ」でかまわない）フォーマット時イベントを次の通りに設定します
印刷ボタンのイベントを次の通りにします
読み込み時（Report_Load）でいいかな？
→印刷だとイベントが発火しない（プレビュー表示なら発火する）
じゃあ開く時（Report_Open）で・・・
→値の変更不可
えー・・・印刷ごとに一回だけ実行されればいいんだけど・・・しかたない、レポートヘッダー使うか
Report_Loadイベントを使って、プレビュー表示→
PrintOut→Closeを繰り返してもいいとは思いますhiroton様
お返事遅くなり、すみません。
結局、hiroton様の Replace(計算式, rs!ID, rs!単価)をループさせるやり方を行ないました。
そして、Eval関数。
おかげ様で、無事、計算結果が算出されました。
ありがとうございました。
そうですね💦
新しいトピックで質問させて頂きます。
取りあえず、元の質問と内容が変わりそうなので、「新しいトピックを作る」から新たに質問を立てると良いと思います
初めての相談になります。
VBA超初心者ですが教えて下さい。
フォーム上で「印刷部数」をテキストボックスに入力して、印刷ボタンを押すと指定した部数を印刷し
さらに連番も一緒に印刷されるようにするにはどうすれば良いのでしょうか？
【印刷部数】というテキストボックスを作成し、印刷ボタンを下記インベントプロシージャを設定しています。
Private Sub cmdPrint_Click()
Const DocName = "T_ケースマーク印刷データ（Tag Noあり） のコピー"
DoCmd.Echo False
DoCmd.OpenReport DocName, acViewPreview
DoCmd.PrintOut acPrintAll, , , , Me!印刷部数
DoCmd.Close acReport, DocName
DoCmd.Echo True
End Sub
宜しくお願い致します。
ちょっと説明不足な部分があるので補足します。
パスワードを設定したAccessデータベースのパスワードを解除(リセット)するには、パスワードが必要です。そのパスワードを忘れたら基本的にはどうしようもありません。パスワードなしに解除できたらパスワードの意味かないですからね。
それを裏技的な方法で解除する方法はあるようです。ただ、かなり古い情報なので、最新のバージョンで使えるかどうかは分かりません。
これに関しては、Accessがランタイム版になっている可能性はないでしょうか。確認してみてください。
ACCESS Runtime（ランタイム）とは - たすけてACCESS
買い直したり作り直したりするほうが早くないかしら？