Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

2079 / 9994

←次へ　｜　前へ→


	【11195】空白ラベルの作り方

こばちゃん - 09/9/28(月) 13:36 -


	引用なし

	パスワード

下記はアクセスに詳しい人が作ったものです。ラベル印刷をする際のモジュールにある印刷のプログラムのコピーです。これは、印刷する際、患者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

607 hits

▼

【11195】空白ラベルの作り方 こばちゃん 09/9/28(月) 13:36