| |
下記はアクセスに詳しい人が作ったものです。ラベル印刷をする際のモジュールにある印刷のプログラムのコピーです。これは、印刷する際、患者ID=Nullとして空白を作成していますが、そうでなくてスキップする方法を教えてください。
Option Compare Database
Public 入力患者ID As Long, 新患者, Wcnt, Werr, 枚数, i, AkiLabel As Integer
Dim db As Database, mySQL, Wsyori As String
Dim F患者ID, F処方, F印刷, F原始 As Recordset
Function ラベル印刷(Wsyori, Werr)
Set db = CurrentDb
mySQL = "DELETE * FROM TT_ラベル印刷": db.Execute mySQL
mySQL = "DELETE * FROM TT_ラベル原始": db.Execute mySQL
If Wsyori = "個人" Then DoCmd.OpenQuery "Q_個人のラベル作成"
If Wsyori = "病棟" Then DoCmd.OpenQuery "Q_病棟のラベル作成"
Werr = 0
If DCount("*", "[TT_ラベル原始]") = 0 Then
MsgBox ("ラベル作成対象レコードはありません"):
Werr = 1
Exit Function
End If
AkiLabel = InputBox("空きラベル枚数を入力してください", "ラベル印刷", 0)
Set F印刷 = db.OpenRecordset("TT_ラベル印刷", dbOpenTable)
Set F原始 = db.OpenRecordset("TT_ラベル原始", dbOpenTable)
For i = 1 To AkiLabel: GoSub F空白ラベル作成: Next
Do Until F原始.EOF
枚数 = 0
For i = 1 To F原始![枚数]: GoSub Fラベル作成: Next
F原始.MoveNext
Loop
If DCount("*", "[TT_ラベル印刷]") = 0 Then
MsgBox ("ラベル作成対象レコードはありません"):
Werr = 1
Exit Function
End If
DoCmd.OpenReport "R_ラベル作成", acNormal
'DoCmd.OpenReport "R_ラベル作成", acPreview
Exit Function
F空白ラベル作成:
F印刷.AddNew: F印刷![患者ID] = Null: F印刷.Update: Return
Fラベル作成:
枚数 = 枚数 + 1
F印刷.AddNew
F印刷![患者ID] = F原始![患者ID]
F印刷![氏名] = F原始![氏名] & "様"
If F原始![氏名] <> F原始![ふりがな] Then F印刷![ふりがな] = F原始![ふりがな]
F印刷![病棟] = F原始![病棟]
'F印刷![処方ID] = F原始![処方ID]
F印刷![品名] = F原始![品名]
F印刷![管理単位] = F原始![管理単位]
F印刷![施行日表題] = "施行日"
If Wsyori = "病棟" Then F印刷![施行日] = Format(Forms![F_初期画面]![施行日], "ggge""年""m""月""d""日")
If Wsyori = "個人" Then F印刷![施行日] = Format(Forms![F_患者処方]![施行日], "ggge""年""m""月""d""日")
' F印刷![枚数] = "(" & 枚数 & "／" & F原始![枚数] & ")"
F印刷.Update
Return
End Function
|
|
![[未読]](./data/access/image/read_icon.gif){kind=icon}
