FC2ブログ
エホバの証人二世の、個人研究&趣味blogです。
2018/07«│ 2018/08| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 »2018/09
文字色の変化のON/OFFが出来ます。文字サイズ文字サイズ:大文字サイズ:中文字サイズ:小
06:34:38
冷え取り健康法を始めました。そしたら早速体調不良が。
めんげんと言うものを信じているわけではないので、胃腸科へ……。そしたら先生の一言「出しきってしまいましょう」
一応吐き気止めはだしますが、本当に辛い時だけ飲んでください。
「え!?!?」と言う感じでした。
この症状、PMSで先月も先々月も同じときくらいに病院に行ったので婦人科にも行った方がいいと言われ行きました。
1時間かけて、ちょっと離れた病院まで。
そこでは体の冷えを指摘されました。顔が赤くなりにくいだけで、顔や頭はいつも熱いし、相当冷えが酷いらしい。
現在は冷え取り(足湯)と靴下の重ねばき(絹+綿+くるぶしソックス+タイツ二枚+レッグウォーマー)、湯たんぽを毎日しています。
乾燥生姜や塩(私の場合は味噌と塩辛)、唐辛子(生七味や一味唐辛子・唐辛子ペースト)も毎日食べてます。
それでも寒いので足元ヒーターも使用します。上半身はタンクトップ+長袖シャツ一枚です。
運動は床に足台を置き、そこで足の上げ下げをしながら裁縫とか読書とかしています。


印刷後処理のマクロです。
印刷した書類が一つ&対象者は複数の場合の処理を追加しました。

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim sh As Object
Application.OnTime Now(), "ThisWorkbook.After_Insatsu"
End Sub
Private Sub After_Insatsu()

Dim x As Long
Dim flg As Integer
Dim y As Long
Dim flflg As String
flflg = ""
nnn = 0
For Each sh In ActiveWindow.SelectedSheets
x = 1
flg = 0
namae = ""
If InStr(sh.Name, "(") <> 0 Then
namae = Mid(sh.Name, InStrRev(sh.Name, "(") + 1)
namae = Replace(namae, ")", "")
insatsu = Left(sh.Name, InStrRev(sh.Name, "(") - 1)
ElseIf InStr(sh.Name, " (") <> 0 Then
namae = Mid(sh.Name, InStrRev(sh.Name, "(") + 1)
namae = Left(namae, Len(namae) - 1)
insatsu = Left(sh.Name, InStrRev(sh.Name, " ") - 1)
Else
insatsu = sh.Name
End If
x = 1
On Error Resume Next

'namaeがあり、1対1の書類の場合

Set s = Worksheets("提出書類(" & namae & ")")
Set s = Worksheets("会社提出書類(" & namae & ")")
On Error GoTo 0
If IsEmpty(s) = False Then
Do Until s.Cells(x, 1) = ""
If s.Cells(x, 1) = insatsu Then
s.Cells(x, 1).Font.Strikethrough = True
End If
x = x + 1
Loop
End If

'namaeの無い場合
If namae = "" Then
For Each ws In Worksheets
If InStr(ws.Name, ("提出書類(")) <> 0 Then
x = 1
Do Until ws.Cells(x, 1) = ""
If ws.Cells(x, 1) = insatsu Then
ws.Cells(x, 1).Font.Strikethrough = True
End If
x = x + 1
Loop
End If
If InStr(ws.Name, ("会社提出書類(")) <> 0 Then
x = 1
Do Until ws.Cells(x, 1) = ""
If ws.Cells(x, 1) = insatsu Then
ws.Cells(x, 1).Font.Strikethrough = True
End If
x = x + 1
Loop
End If
Next
Else

'namaeがあるが、書類によって処理が違う場合
For Each ws In Worksheets
If InStr(ws.Name, ("提出書類(")) <> 0 Then
x = 1
Do Until ws.Cells(x, 1) = ""
If ws.Cells(x, 1) = insatsu Then
rc = MsgBox(ws.Name & "の"&"insatsu&"を追加しますか?", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
ws.Cells(x, 1).Font.Strikethrough = True
End If

End If
x = x + 1
Loop
End If
If InStr(ws.Name, ("会社提出書類(")) <> 0 Then
x = 1
Do Until ws.Cells(x, 1) = ""
If ws.Cells(x, 1) = insatsu Then
rc = MsgBox(ws.Name & "の"&"insatsu&"を追加しますか?", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
ws.Cells(x, 1).Font.Strikethrough = True
End If
End If
x = x + 1
Loop
End If
Next
End If
Next sh

End Sub

チェックしたシートの色を変更し保護するマクロも作成しました。
全て保護をしておくことで、変な入力が減ります。式が入っているところはマスタデータを変更すれば自動計算されるので特に問題ないのです。
Sub チェックしたシートの色を変更し保護する()
Dim u As Variant
Dim kazu As Long
kazu = ActiveWindow.SelectedSheets.Count
ReDim u(kazu)
Dim i As Long
i = 0
For Each sh In ActiveWindow.SelectedSheets
u(i) = sh.name
i = i + 1
sh.Tab.Color = 6684927
Next sh
ActiveWindow.SelectedSheets(1).Select

For k = 0 To UBound(u) - 1
On Error Resume Next
Worksheets(u(k)).Unprotect
j = Worksheets(u(k)).Protection.AllowEditRanges.Count
If i = 0 Then Exit Sub

For j = i To 1 Step -1
Worksheets(u(k)).Protection.AllowEditRanges(j).Delete
Next j

Worksheets(u(k)).Protect
On Error GoTo 0
Next

End Sub

コメント
コメントの投稿










トラックバック
トラックバックURL
→http://ayukt0526.blog.fc2.com/tb.php/333-8811b5ca
この記事にトラックバックする(FC2ブログユーザー)
プロフィール

はなかな

Author:はなかな
FC2ブログへようこそ!

最新記事
最新コメント
月別アーカイブ
カテゴリ
フリーエリア
ランキング参加しています。 にほんブログ村 哲学・思想ブログ エホバの証人へ にほんブログ村 にほんブログ村 本ブログ 読書日記へ にほんブログ村 にほんブログ村 音楽ブログへ にほんブログ村
音楽(J-POP) ブログランキングへ
小説(読書感想) ブログランキングへ
キリスト教 ブログランキングへ
ブログランキング ブログ王ランキングに参加中!
検索フォーム
RSSリンクの表示
リンク
このブログをリンクに追加する
ブロとも申請フォーム

この人とブロともになる

QRコード
QR
FC2アフィリエイト