142 lines
3.7 KiB
QBasic
142 lines
3.7 KiB
QBasic
Attribute VB_Name = "Module1"
|
|
Sub 全To前コピー()
|
|
|
|
Dim 全シート, 前シート As Worksheet
|
|
Dim 全リスト, 前リスト As Object
|
|
|
|
Set 全シート = Sheets("全")
|
|
Set 前シート = Sheets("前")
|
|
|
|
全シート.Select
|
|
Set 全リスト = 全シート.ListObjects("全")
|
|
前シート.Select
|
|
Set 前リスト = 前シート.ListObjects("前")
|
|
|
|
If Not 前リスト Is Nothing Then 前リスト.DataBodyRange.Delete
|
|
|
|
全リスト.DataBodyRange.Copy 前シート.Range("A2")
|
|
|
|
全シート.Select
|
|
全リスト.QueryTable.Refresh
|
|
|
|
|
|
End Sub
|
|
|
|
'フラグ一括削除
|
|
Sub クリア()
|
|
Application.ScreenUpdating = False
|
|
Dim 指示書リスト As Worksheet
|
|
Set 指示書リスト = Worksheets("指示書期限切れ")
|
|
|
|
'フラグ一括削除
|
|
指示書リスト.Range("O6:O65").Value = ""
|
|
|
|
Application.ScreenUpdating = True
|
|
End Sub
|
|
|
|
|
|
Sub 送付状作成()
|
|
Application.ScreenUpdating = False
|
|
|
|
Dim 指示書リスト As Worksheet
|
|
Dim 送付状 As Worksheet
|
|
|
|
Set 指示書リスト = Worksheets("指示書期限切れ")
|
|
|
|
Dim i, j, p
|
|
|
|
|
|
j = 27
|
|
p = 0
|
|
|
|
Dim lastRow As Long
|
|
lastRow = 指示書リスト.Cells(指示書リスト.Rows.Count, "D").End(xlUp).Row
|
|
|
|
For i = 6 To lastRow
|
|
Dim f1, f2, f3
|
|
f1 = 指示書リスト.Cells(i, 15).Value '送付状作成対象
|
|
f2 = 指示書リスト.Cells(i, 14).Value '複数名患者
|
|
f3 = 指示書リスト.Cells(i, 11).Value '確認済みは除外
|
|
|
|
If f1 = 1 And f3 = "" Then
|
|
If f2 = 1 Then
|
|
'単名送付状
|
|
Set 送付状 = Worksheets("送付状1")
|
|
|
|
'病院〒
|
|
送付状.Range("D2").Value = 指示書リスト.Cells(i, 12).Value
|
|
'病院住所
|
|
送付状.Range("E2").Value = 指示書リスト.Cells(i, 13).Value
|
|
'病院名
|
|
送付状.Range("F2").Value = 指示書リスト.Cells(i, 10).Value
|
|
'主治医
|
|
送付状.Range("G2").Value = 指示書リスト.Cells(i, 9).Value
|
|
'利用者名
|
|
送付状.Range("H2").Value = 指示書リスト.Cells(i, 4).Value
|
|
'指示開始日
|
|
送付状.Range("I2").Value = 指示書リスト.Cells(i, 17).Value
|
|
'生年月日
|
|
送付状.Range("J2").Value = 指示書リスト.Cells(i, 8).Value
|
|
|
|
p = 1
|
|
指示書リスト.Cells(i, 15).Value = "済"
|
|
|
|
Else
|
|
'複数名送り状
|
|
Set 送付状 = Worksheets("送付状2")
|
|
'病院〒
|
|
送付状.Range("D2").Value = 指示書リスト.Cells(i, 12).Value
|
|
'病院住所
|
|
送付状.Range("E2").Value = 指示書リスト.Cells(i, 13).Value
|
|
'病院名
|
|
送付状.Range("F2").Value = 指示書リスト.Cells(i, 10).Value
|
|
|
|
'利用者名
|
|
送付状.Cells(j, 7).Value = 指示書リスト.Cells(i, 4).Value & " 様"
|
|
'生年月日
|
|
送付状.Cells(j, 12).Value = 指示書リスト.Cells(i, 8).Value
|
|
j = j + 1
|
|
'指示開始日
|
|
送付状.Cells(j, 7).Value = 指示書リスト.Cells(i, 17).Value
|
|
j = j + 1
|
|
|
|
p = 2
|
|
|
|
指示書リスト.Cells(i, 15).Value = "済"
|
|
|
|
End If
|
|
|
|
End If
|
|
|
|
|
|
'印刷実行処理
|
|
If p = 1 Then
|
|
送付状.Activate
|
|
ActiveWindow.SelectedSheets.PrintOut Copies:=1
|
|
|
|
p = 0
|
|
|
|
Elseif p = 2 Then
|
|
'病院の切替りを判定
|
|
If Not 指示書リスト.Cells(i, 10).Value = 指示書リスト.Cells(i + 1, 10).Value Then
|
|
|
|
送付状.Activate
|
|
ActiveWindow.SelectedSheets.PrintOut Copies:=1
|
|
送付状.Range("G27:G42").Value = ""
|
|
送付状.Range("L27:L42").Value = ""
|
|
j = 27
|
|
|
|
p = 0
|
|
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
指示書リスト.Activate
|
|
|
|
Application.ScreenUpdating = True
|
|
End Sub
|
|
|
|
|
|
|