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
Public Function 受付日(申請日 As Variant, Optional 営業日数 As Long = 1) As Variant
Dim 営業日 As Long
受付日 = 申請日
If IsNull(受付日) Or 営業日数 = 0 Then Exit Function
While 営業日 < Abs(営業日数)
受付日 = 受付日 - 1
Select Case Weekday(受付日)
Case vbMonday To vbFriday
If IsNull(DLookup("祝日名", "T_祝日", "日付=#" & 受付日 & "#")) Then
営業日 = 営業日 + 1
End If
End Select
Wend
End Function
説明不足で申し訳ありません。実は申請日を受付日の翌日にするよう業務処理の変更(当日急いですれば間違いの発生
の恐れがあり、その防止のため)がありましたので
下記の式により処理したいと思っています。
申請日TXTは Date()により
出来日は下記式により
Public Function 許可日(申請日 As Variant, Optional 営業日数 As Long = 3) As Variant
Dim 営業日 As Long
許可日 = 申請日
If IsNull(許可日) Then Exit Function
Do
許可日 = 許可日 + 1
Select Case Weekday(許可日)
Case vbMonday To vbFriday
If IsNull(DLookup("祝日名", "T_祝日", "日付=#" & 許可日 & "#")) Then
営業日 = 営業日 + 1
End If
End Select
Loop Until 営業日 = 営業日数 - 1
End Function
そして受付日をVBAにて処理し
下記式によりF車庫証明にうつり処理したいと思っています。
DoCmd.OpenForm "F車庫証明"
If IsNull(Me.至ID) Then
Else
Forms!F車庫証明.SetFocus 'F車庫証明をアクティブにする（念の為）
For Sx = 1 To Me.至ID
DoCmd.GoToRecord acActiveDataObject, , acNewRec
Forms!F車庫証明![ 受付日] = Me.[ 受付日TXT]
Forms!F車庫証明![申請日] = [申請日TXT]
'Forms!F車庫証明![出来上日] = [出来日TXT]
DoCmd.RunCommand acCmdSaveRecord
Next Sx
よろしくご教示願います。
Public Function 許可日(申請日 As Variant, Optional 営業日数 As Long = 3) As Variant
Dim 営業日 As Long
Dim 増量 As Long
許可日 = 申請日
If IsNull(許可日) Or Abs(営業日数) <= 1 Then Exit Function
増量 = IIf(営業日数 > 0, 1, -1)
Do
許可日 = 許可日 + 増量
Select Case Weekday(許可日)
Case vbMonday To vbFriday
If IsNull(DLookup("祝日名", "T_祝日", "日付=#" & 許可日 & "#")) Then
営業日 = 営業日 + 増量
End If
End Select
Loop Until 営業日 = 営業日数 - 増量
End Function
Sub test()
'呼び出し例
Debug.Print "許可日から申請日を求める -> " & 許可日(#10/15/2024#, -2)
Debug.Print "申請日から許可日を求める -> " & 許可日(#10/11/2024#, 2)
End Sub
Sub Sample1()
Dim rs As DAO.Recordset
Set rs = Me.Recordset.Clone
rs.MoveFirst
Do Until rs.EOF
rs.Edit
rs!F1 = rs!F2 & rs!F3 & rs!F4
rs.Update
rs.MoveNext
Loop
Me.Recalc
rs.Close: Set rs = Nothing
End Sub
Sub Sample2()
Dim stSQL As String
stSQL = "UPDATE Tbl1 SET F1 = F2 & F3 & F4"
If Me.FilterOn And Me.Filter <> "" Then
stSQL = stSQL & " WHERE " & Me.Filter
End If
CurrentDb.Execute stSQL
Me.Requery
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF1 Then
KeyCode = 0 'キー入力を無効化
If Me.FilterOn = False Then
Me.Filter = "終了チェック = False"
Me.FilterOn = True
End If
End If
End Sub
SELECT 製品ID
, Sum( 小計 ) As 小計の合計
, Sum( 実装費 ) As 実装費の合計
FROM
(
SELECT 製品ID
, 小計
, CCur(0) As 実装費
FROM Q部品構成F_Sub用RS
UNION ALL
SELECT 製品ID
, 0
, 実装費
FROM Q組立構成F_Sub用RS
) q
GROUP BY 製品ID
;
Private Sub Report_Open(Cancel As Integer)
DoCmd.OpenForm "F印刷設定", OpenArgs:=Me.Name
End Sub
Private Sub Report_Close()
DoCmd.Close acForm, "F印刷設定"
End Sub
Private Sub Form_Open(Cancel As Integer)
rptName = Me.OpenArgs 'ﾚﾎﾟｰﾄ名取得
End Sub
Private Sub cmd直ちに印刷_Click()
If vbOK = MsgBox("直ちに印刷を開始します。", vbOKCancel) Then
DoCmd.OpenReport rptName, acViewNormal, "", "", acNormal
DoCmd.Close acForm, Me.Name, acSaveNo '自身を閉じる
Else
MsgBox "印刷処理を中止します。", vbCritical
End If
End Sub
途中のデータ行の 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
買い直したり作り直したりするほうが早くないかしら？
この手の情報は大っぴらに公開すると悪用される場合があるので、こういう場所では提供しずつらいですね。
「Access パスワード 忘れた」で検索すると方法は出てくるようです。私はしたことがありませんので、可能かどうかは分かりません。
それでだめなら業者に有料でやってもらうことになるでしょう。
mayu様解決しました。大変ありがとうございました。これで作業が進みます。
りんご様お気遣いありがとうございました。
有難うございます。
無事に出来ました。
この度は有難うございました。
>当日急いですれば間違いの発生の恐れがあり、その防止のため)がありましたので
年間スケジュールを決め打ちすれば、無駄なコードを作って365日毎回走らせなくて済むんじゃ無いかしら。
という解釈で合ってますか
あとは F車庫証明フォームを開く前に、カレントフォームの適切なイベントで
受付日TXTへ 受付日関数の結果を代入すればいいでしょう
ということでしたら、以下３つの記述はいずれも同じ結果になります
説明不足で申し訳ありません。実は申請日を受付日の翌日にするよう業務処理の変更(当日急いですれば間違いの発生
の恐れがあり、その防止のため)がありましたので
下記の式により処理したいと思っています。
申請日TXTは Date()により
出来日は下記式により
Public Function 許可日(申請日 As Variant, Optional 営業日数 As Long = 3) As Variant
Dim 営業日 As Long
許可日 = 申請日
If IsNull(許可日) Then Exit Function
Do
許可日 = 許可日 + 1
Select Case Weekday(許可日)
Case vbMonday To vbFriday
If IsNull(DLookup("祝日名", "T_祝日", "日付=#" & 許可日 & "#")) Then
営業日 = 営業日 + 1
End If
End Select
Loop Until 営業日 = 営業日数 - 1
End Function
そして受付日をVBAにて処理し
下記式によりF車庫証明にうつり処理したいと思っています。
DoCmd.OpenForm "F車庫証明"
If IsNull(Me.至ID) Then
Else
Forms!F車庫証明.SetFocus 'F車庫証明をアクティブにする（念の為）
For Sx = 1 To Me.至ID
DoCmd.GoToRecord acActiveDataObject, , acNewRec
Forms!F車庫証明![ 受付日] = Me.[ 受付日TXT]
Forms!F車庫証明![申請日] = [申請日TXT]
'Forms!F車庫証明![出来上日] = [出来日TXT]
DoCmd.RunCommand acCmdSaveRecord
Next Sx
よろしくご教示願います。
［総使用数］フィールドのデータ型を「集計」にして、
「式」プロパティに
[個数]*[使用数]と設定すればいいでしょう。Accessで集計フィールドを作成する方法 | できるネット
祝日を含めての許可日について の関連質問でしょうか
結論から申し上げると、関数の第二引数に負の数を指定できるようにロジックを変更すればいいでしょう
早々のご回答ありがとうございます。
第一案でできそうです。
もう少し勉強します！
単純な式にしかならないのであれば、手入力の問題をどの程度補正するかもありますが、
テーブルBをレコードセットで取得して全レコードループさせて、IDを数値に置き換える
Replace(計算式, rs!ID, rs!単価)なんて方法でもいいかもしれません
計算式が正しいとしてもID部分だけ取り出すのは結構面倒だと思うので、8個くらいの変換なら、存在をチェックせずそのまますべて変換するという楽をしてもいいと思います
処理を何度も繰り返すような場合は、テーブルBを何度もレコードセットにとる（テーブルのOpen、Closeが繰り返される）ようなことがないように気を付ける必要があるかもしれません
hiroton様
ご回答ありがとうございます。
質問で、計算式の例で、「×」を用いましたが、サイトでの表示に問題があったため、アスタリスクをあえて「×」に書き換えました。本来はアスタリスクです。
また、ユーザーの式自体は、＋、－、×、÷と()でのくくりくらいの単純な計算式となります。
もともと、業務用ソフトでユーザーが式を作成・使用され、認識されていた式です。式データをエクスポートしたかたちです。
計算式として認識できない場合は、空欄としようと思っています。
テーブルBに関しては、レコードが8個固定となります。
単価のみ書き換わることがあるくらいです。
Eval関数使って、やってみます。あと、Dlookupも。
また、やってみた結果をお伝えさせていただきますね。
２つの案が考えられます。
第一案
フォームのレコードセットを操作して更新する。
フィールド名は F1, F2, F3, F4 と仮定してます。
フォーのレコードセットの扱いについては下記をご参考に。
フォームの Recordset, RecorsetClone, RecordSet.Clone の違いとは？ - hatena chips
第２案
フォームのFilterプロパティで抽出条件を取得して、それを利用して更新クエリを実行する。
フォームのレコードソースのテーブル名はTbl1と仮定
Eval 関数が使えるかもしれません
ただし、入力した文字列がVBAの計算式として認識できる場合なら計算結果を求めることができるというものになるので、当然ながら全角の「
×÷」等はそのままでは使えませんIDを数値に変えるのはDLookup 関数でテーブルを参照すればいいでしょう
ただし、入力した文字列の中のどの部分がIDに相当するか？を判断する必要があります
IDの大文字小文字、全角半角が正しく扱えるか？はデータベースの設定に依存する場合があります。数字も数値として認識できるか？は細かな調整が必要になるでしょう
１．入力された文字列を計算式としての「項」と「演算子」に分解する
２．「項」がそのまま使える数値なのか、IDを参照する文字列なのか判定し、必要に応じてテーブルから数値を拾い出し置き換える
３．「演算子」をACCESS（VBA）で認識できる文字に置き換える
４．Eval関数で計算する
「()」（演算の優先順位指定）や「cos()」（よく使われる数学関数）等を考慮していません
「ユーザーが入力した計算式」にどこまでの自由度を設けるかで内容の複雑さが変わります。想定されるパターンの洗い出しが必要になるでしょう
回答頂いていながら返信が遅くなり申し訳ありません。長期入院していたため回答できませんでした。
深くお詫びいたします。
帳票フォームのフィルターで表示されたレコードだけに対して、フィールド１の値を変更したいです。
フィールド２、３、４の値を連続した文字列としてフィールド１に入れたいのですが、
これをFor分の中にDoCmd.GoToRecord , , acNextを入れると、エラーになって次のレコードに行けません
このような場合はどう記述するべきなのか、ご教授いただければ幸いです。
よろしくお願いいたします。
sk様
回答ありがとうございました。
参考にさせていただきます。
データシートフォームとは別に非連結フォームを新規作成する。
1 の非連結フォームの詳細セクション上にサブフォームコントロールを挿入する。
2 のサブフォームコントロールのソースオブジェクトをデータシートフォームとする。つまり、非連結フォームをメインフォーム、データシートフォームをサブフォームとする。
メインフォームの詳細セクション上にコマンドボタンを挿入する。
4 のコマンドボタンの[クリック時]イベントの発生時に、サブフォームのフィルターを操作するマクロまたはプロシージャを実行するようにする。
といった方法もあるでしょう。
ありがとうございました。
勉強になりました
mayuさん分かり易い解説ありがとうございます。
ﾘﾚｰｼｮﾝしているからと言ってもどんなﾃﾞｰﾀの関係になっているかですね。大変参考になりました。
お世話になりました。
データシートビューでフォームを開いているときに、ユーザーが任意のタイミングで実行するのでしょうか。
ボタンは配置できないので、特定のキー操作(ショートカットキー)で実行するようにすればどうでしょう。
フォームの「キーボードイベント取得」プロパティを「はい」にしておいて、「キークリック時」のイベントプロシージャに下記のように記述すればいいでしょう。
下記はフォームがアクティブの時にF1キーをの押したときに実行する例です。
回答ありがとうございました。
通貨型に変更します
ユニオンクエリを使う場合は仰るとおりです
JOINで実装する場合は
結合キーである製品IDが、２つのクエリで どのような関係性にあるか
が成否(表内の〇と×)の要因となります
今回のご質問では、SQ文で利用されている２つのクエリに対し
行を一意にするキー項目の判別ができなかったこともあり
データの性質次第では、SQLの結果セットで 行の欠損が発生したり 誤った集計結果が出る
という現象を回避できる
ユニオン(縦結合)の回答が適切と判断しました
mayuさん ありがとうございます。ｺﾋﾟｰしたら上手く出来ました。確かに異なるテーブル同士なのでユニオンでなければ不可能ですね。素晴らしいＳＱＬです！ サブクエリにユニオン使うなんてとても自分では思いつきません。
この形にしないと１つのクエリでは出来ないのですよね？ すみませんテクニックについていけてなくて。
部品構成、組立構成の両クエリとも、製品IDが一意になっていないため
多:多の結合になり、行割れが発生しているのでしょう
こういった場合は、クエリ同士を
横並びに結合するのではなく、縦に結合することでご希望の結果になります
hatenaさん ありがとうございます。
OpenArgsでしたらバッチリ上手く出来ました。感謝します！
紹介されている分もじっくり見て参考にさせて頂きます。
今回もお世話になりました。
下記で紹介しているサンプルなら、上記の点も考慮していますので、よろしければご参考に。
Screen.ActiveReport.Name で対象レポート名を取得するのは不安定そうなので、OpenArgs引数でレポート名を渡せばどうでしょう。
レポートを複数プレビューしたり、プレビュー中に別のレポートを直接印刷したり、などの場合、おかしなことになるので、その辺のことを考慮して、Report_ActivateイベントやReport_Deactivateイベントを利用してレポート名を取得するほうがいいかも。
hatenaさん ありがとうございます。
説明不足だったのですが（すみません）対象ﾚﾎﾟｰﾄを閉じる時のｲﾍﾞﾝﾄに印刷設定ﾌｫｰﾑを閉じるｺｰﾄﾞも記述してます。
ﾌｧｲﾙにはﾌｫｰﾑが幾つかありそれぞれに異なるﾚﾎﾟｰﾄをﾌﾟﾚﾋﾞｭｰするﾎﾞﾀﾝがあります。
最初にこの仕組みのｺｰﾄﾞ記述したﾌｫｰﾑＡのﾚﾎﾟｰﾄAをﾌﾟﾚﾋﾞｭｰするﾎﾞﾀﾝを実行すると問題なかったのですが、次にｺｰﾄﾞ記述したﾌｫｰﾑBのﾚﾎﾟｰﾄBをﾌﾟﾚﾋﾞｭｰするﾎﾞﾀﾝを実行するとｴﾗｰが発生（ﾚﾎﾟｰﾄ名が取得出来ていない）になるのです。試しに印刷設定ﾌｫｰﾑに MsgBox "名前は" & rptName のﾎﾞﾀﾝを作成して様子みるとＡの方は名前が表示されますが、Bでは無理です。ﾚﾎﾟｰﾄBにはｻﾌﾞﾚﾎﾟｰﾄがあるのでその影響と思いｻﾌﾞﾚﾎﾟｰﾄを消しても状況は同じでした・・・
データ量(行数×列数)はどのくらいでしょうか。
hatena様
お返事ありがとうございます。
重複者についてはカンマ区切りでできればと思います。ただ、難しい事がわからないため、改行の方が難しくないのであれば、できるだけ易しい方が希望です。
最終目的は、予約日時を個人にデータで案内をする事です。
まずは教えていただいた、Djoin関数を見てみたいと思います。
りんごさま
お返事ありがとうございます。
アクセスのクロス集計にこだわりはなく、データが多くエクセルの場合、固まってしまうことから
初心者ながらアクセスの方がいいのではと思った次第です。
そのことから、エクセル掲示板ではまだ質問はしていません。
「cmd直ちに印刷」をクリックしてレポートを印刷した後も「F印刷設定」フォームが開いたままなのが原因と思われます。開いたままだと、Form_Loadイベントは発生しませんので。
とりあえずの対策としては、印刷したら印刷設定フォームを閉じればいいでしょう。
ただ、レポートをプレビューせずに直接印刷したときとか、レポートのプレビューを閉じてしまった時のことも考慮する必要があるでしょう。