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が出来ます。文字サイズ文字サイズ:大文字サイズ:中文字サイズ:小
23:08:01
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 = 16711782
Next sh
ActiveWindow.SelectedSheets(1).Select

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

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


Worksheets(u(k)).PrintOut

'チェックリストを使用する場合
'「会社提出書類(」「提出書類(」は変更可

Dim buf As String
buf = InputBox(Worksheets(u(k)).name & "名前を入力してください")
On Error Resume Next
x = 1
Do Until x = 10000
If InStr(Worksheets(u(k)).name, Worksheets("会社提出書類(" & buf & ")").Cells(x, 1)) <> 0 Then
Worksheets("会社提出書類(" & buf & ")").Cells(x, 1).Font.Strikethrough = True
Exit Do
End If
x = x + 1
Loop
x = 1
Do Until x = 10000
If InStr(Worksheets(u(k)).name, Worksheets("提出書類(" & buf & ")").Cells(x, 1)) <> 0 Then
Worksheets("提出書類(" & buf & ")").Cells(x, 1).Font.Strikethrough = True
Exit Do
End If
x = x + 1
Loop
On Error GoTo 0


Next
Application.ScreenUpdating = False
For k = 0 To UBound(u) - 1
MaxRow = 0
MaxCol = 0
Worksheets(u(k)).Activate
With Worksheets(u(k)).UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With
Worksheets(u(k)).Range("a1", Cells(MaxRow, MaxCol)).Value = Worksheets(u(k)).Range("a1", Cells(MaxRow, MaxCol)).Value
Worksheets(u(k)).Protect
Next
Application.ScreenUpdating = True
End Sub


割と荒削りなマクロです。
コンパイルは毎回きちんとしています。ブログに貼り付けているのでコピーから直すときに時間がかかるかも?と言った感じです。
小説用とかにすればそんなことないのかなぁ???

コメント
コメントの投稿










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

はなかな

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

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

この人とブロともになる

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