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が出来ます。文字サイズ文字サイズ:大文字サイズ:中文字サイズ:小
22:06:39
Sub 直接入力した書類のチェックリスト()

On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("直接入力した書類のチェックリスト").Delete
On Error GoTo 0


Dim myMenu As CommandBarPopup
Dim myWsMenu As CommandBar, myMenumyMenu As CommandBar

Set myWsMenu = Application.CommandBars("Worksheet Menu Bar")
Dim 直接入力した書類のチェックリスト As CommandBarPopup

Set 直接入力した書類のチェックリスト = myWsMenu.Controls.Add _
(Type:=msoControlPopup, Temporary:=True)
直接入力した書類のチェックリスト.Caption = "直接入力した書類のチェックリスト"

Dim 直接入力した書類のチェックリスト追加 As CommandBarButton
Set 直接入力した書類のチェックリスト追加 = 直接入力した書類のチェックリスト.Controls.Add _
(Type:=msoControlButton, Temporary:=True)
直接入力した書類のチェックリスト追加.OnAction = "直接入力した書類のチェックリスト追加"
直接入力した書類のチェックリスト追加.Caption = "直接入力した書類のチェックリスト追加"
直接入力した書類のチェックリスト追加.Style = msoButtonCaption



On Error Resume Next
With ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
End With
On Error GoTo 0
If MaxRow <> 0 Then
x = 0
Dim keiyakusyo2 As Variant
keiyakusyo2 = ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Range(ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(1, 1), ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(MaxRow, 4))
Dim 直接入力した書類のチェックリスト_2(10000) As CommandBarButton
For i = 1 To UBound(keiyakusyo2)
If InStr(keiyakusyo2(i, 1), ".xls") <> 0 Then
If keiyakusyo2(i, 1) <> "" And keiyakusyo2(i, 2) = "" Then
Set 直接入力した書類のチェックリスト_2(x) = 直接入力した書類のチェックリスト.Controls.Add _
(Type:=msoControlButton, Temporary:=True)
直接入力した書類のチェックリスト_2(x).OnAction = "直接入力した書類のチェックリスト2"
a = Len(keiyakusyo2(i, 1)) - Len(Mid(keiyakusyo2(i, 1), InStrRev(keiyakusyo2(i, 1), "\")))
a = Left(keiyakusyo2(i, 1), a)

b = Len(a) - Len(Mid(a, InStrRev(a, "\")))
b = Left(a, b)
直接入力した書類のチェックリスト_2(x).Caption = Mid(b, InStrRev(b, "\") + 1) & Mid(a, InStrRev(a, "\") + 1) & Mid(keiyakusyo2(i, 1), InStrRev(keiyakusyo2(i, 1), "\"))
直接入力した書類のチェックリスト_2(x).TooltipText = keiyakusyo2(i, 4)
x = x + 1
End If
Else
If keiyakusyo2(i, 1) <> "" And keiyakusyo2(i, 2) = "" Then
Set 直接入力した書類のチェックリスト_2(x) = 直接入力した書類のチェックリスト.Controls.Add _
(Type:=msoControlButton, Temporary:=True)
直接入力した書類のチェックリスト_2(x).OnAction = "直接入力した書類のチェックリスト2"
a = Len(keiyakusyo2(i, 1)) - Len(Mid(keiyakusyo2(i, 1), InStrRev(keiyakusyo2(i, 1), "\")))
a = Left(keiyakusyo2(i, 1), a)

b = Len(a) - Len(Mid(a, InStrRev(a, "\")))
b = Left(a, b)
直接入力した書類のチェックリスト_2(x).Caption = Mid(b, InStrRev(b, "\") + 1) & Mid(a, InStrRev(a, "\") + 1) & Mid(keiyakusyo2(i, 1), InStrRev(keiyakusyo2(i, 1), "\"))
直接入力した書類のチェックリスト_2(x).TooltipText = keiyakusyo2(i, 4)
x = x + 1
End If
End If
Next
End If

End Sub


Sub 直接入力した書類のチェックリスト2()
rc = MsgBox("開く場合は「はい」を、削除する場合は「いいえ」をクリックして下さい。", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
x = 1
Do Until ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 1) = ""
If InStr(Replace(ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 1), "\", ""), Replace(CommandBars.ActionControl.Caption, "\", "")) <> 0 Then
Workbooks.Open (ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 1).Value)
With CreateObject("Shell.Application")
.ShellExecute ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 2).Value
End With
Exit Do
End If
x = x + 1
Loop
Else
x = 1
Do Until ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 1) = ""
If InStr(Replace(ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 1), "\", ""), Replace(CommandBars.ActionControl.Caption, "\", "")) <> 0 Then
ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Rows(x).Delete
Exit Do
End If
x = x + 1
Loop
End If
Call 直接入力した書類のチェックリスト
ThisWorkbook.Save
End Sub

Sub 直接入力した書類のチェックリスト追加()

x = 1
Do Until ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 1) = ""
x = x + 1
Loop
ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 1) = ActiveWorkbook.FullName
ChDir ""
strFileName = Application.GetOpenFilename(MultiSelect:=False)
ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 2) = strFileName
Dim buf As String
buf = InputBox("表示したい文字列を入力して下さい")
ThisWorkbook.Worksheets("直接入力した書類のチェックリスト").Cells(x, 3) = buf
Call 直接入力した書類のチェックリスト
ThisWorkbook.Save
End Sub


直接入力をした書類は数回の確認が必要です。
それに、大きなファイルを見ながら手入力したものなんて確認したくありませんので……。
PDFでしたらぱっと印刷する事も出来ますし、大きな画面であれば二画面・三画面表示も十分できるので、それが良いのです。

コメント
コメントの投稿










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

はなかな

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

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

この人とブロともになる

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