FC2ブログ
エホバの証人二世の、個人研究&趣味blogです。
2018/03«│ 2018/04| 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 »2018/05
文字色の変化のON/OFFが出来ます。文字サイズ文字サイズ:大文字サイズ:中文字サイズ:小
2018/04/28
07:43:35
FDT以外でも、チェックリストが必要になることって多いですよね。
データベースは直接入力→更新と言う形の方が楽かと思うので、ただいま変更中です。それ以外にも入力は減らす方法で考えています。
それ以外にも、PDFを印刷しないようにするとか……色々とありますね。
必要ないときはPDFは印刷出来ないようにするといいですね。紙やインク、時間の節約にもなりますので。

Sub Test()
Set w = CreateObject("WScript.Shell")
Dim target As Variant
For Each target In Selection
If Range(target.Address).Hyperlinks.Count > 0 Then
w.Run ("AcroRd32.exe /t " & Chr(34) & Range(target.Address).Hyperlinks(1).Address & Chr(34))
End If

Next
Set w = Nothing
End Sub
23:06:13
なんか、おもしろくてプレイしてしまいます(笑)


たまにわからなくなって……うわぁ(`_´)

四字熟語ってよく見るけどたまにわからなくなるのよね。
22:38:48
FileDateTime関数を使用すると、ファイルの更新日を表示することか出来ます。
今回、ユーザー定義関数を使用しました。Hyperlinkを取得して、日付が出て来ます。

Function FDT(a As Range)
FDT = FileDateTime(a.Hyperlinks(1).Address)
FDT = CDate(Year(FDT) & "/" & Month(FDT) & "/" & Day(FDT))
End Function

無題

更新日がFDTで出した日付です。
これでPDF確認できるよ~~~。すごく便利で楽です。
みんなはこういうことしないの??? どうなの???

大体PDF毎回確認しないでしょ、、、。
更新はぽんって出来るようにフォルダ分けないとか、全部Send Toに入れるとか方法は一杯有るね。

Windows7でSend toを編集する方法も分かったよ。
無題

C:\Users\(略)\AppData\Roaming\Microsoft\Windows\SendTo
ここにあったのか、お前。これから毎日使えるぞ!!!
09:05:13
恒例の新人さん無茶ぶりが終わりました~。
今回私はマクロとエクセルの教育係になってしまい、一から一つずつテキストを作

ることになりました。

①マクロを使用できるようにする。
②セルに文字を書く
③セルの書式を変更する
④CellsとRangeの違い
⑤選択したセルの文字をメッセージボックスで表示させる
⑥変数を宣言する
⑦エクセルの文字列を変数に代入し、別のセルにいれる
⑧計算してからセルに代入する
⑨二つのセルを計算し、別のセルに代入する
⑩一次元配列に代入する
⑪一次元配列の中から必要なものだけ抽出し、別シートに記入する
⑫IF文を使用してデータを入力する

必要なところはこの辺ですかね。
後はブックを開く・上書きして閉じる・上書きしないで閉じる・シートの指定あたりかなぁ~。
高速化の変数指定等はおいおいと言うところかな。

無題

テキストサンプル!!! めっちゃ面倒臭いです;;;
RangeとCellsの説明の違いとか、、、RowとColumnとか本当面倒臭い……。
新人さんもう少しマクロとか自分で覚えて欲しい。お陰で自分の勉強が出来ないです、、、。

ピカチュウのうたがすごく可愛いです。

2018/04/20
19:42:07
相方さん大好きな私。
可愛いし優しいし色白だしマシュマロだし……
私と相方さんで外出するとねこぺん日和みたいになります(*^ー^)

https://youtu.be/Ki_2QSjrWf4

ねこぺん日和ですよー。



これ買ってしまいましたよ😁
ぬいぐるみもほしい。ガチャガチャもしています。
めっちゃ可愛い相方さんみたいなのです。

ひさしぶりに会って、やっぱり癒されました。



2018/04/19
21:08:36
送付状を自動で作ってくれるマクロです。

ダウンロードはこちらです。
送付状.xlsm


無題

無題2

時間がかかるので欲しかったのですが、なかなか時間が無く作ることが出来ませんでした。
次は作成終了チェックを作りたいです。
印刷は印刷でチェックがあるのですが、印刷するたびにチェックされてしまうので、印刷後ではなく、作成終了⇒印刷の設定にしようと思います。
(印刷後だと修正が必要の場合や、仮版を印刷した時にもチェックリストに丸が入ってしまいます)

後は重くなりがちなセルの参照とか(エクセルはなぜセルを直接参照するとあそこまで遅くなるの? Valueで文字列を指定しても遅いよね)


あなたがシナモロール王国民だったら「消防士」です。

シナモロール王国民診断

消防士ってなんか格好良いですね。
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


割と荒削りなマクロです。
コンパイルは毎回きちんとしています。ブログに貼り付けているのでコピーから直すときに時間がかかるかも?と言った感じです。
小説用とかにすればそんなことないのかなぁ???
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でしたらぱっと印刷する事も出来ますし、大きな画面であれば二画面・三画面表示も十分できるので、それが良いのです。
2018/04/16
23:14:31



インターチェンジと言うカードゲームをプレイしました。
これは、成功率が低いそうです(^-^)
なかなか成功しなかったよー(*^ー^)



エースズアンドキングスというゲームもすごく難しいです。
どうやったら出来るのーーー??? なかなか上手く出来ません!!! ウィニングディールでも難しいよう;;;
30分ぐらい頑張ってしまいました。。。




この曲好きです~~~。

23:01:35
館殺人事件三作目です。
順番通りに読んでいますが、初見はこれが初めてかなーと思います。
しかし、船丘さん一行も書いていなかったって……どういう事???
それでも殺されるって。他の人たちは皆書いていてその『見立て』どおりに殺されてるよね???
と思ったらやっぱりでしたか~~~。怪しいと思ったんだよね。
隠れるために警察への連絡はダメ。電話線も切ってある。いつも通りの建築家先生は遊んで隠し扉作ってる。

最後のオチもよかったです。私はやっぱり綾辻先生好きですね。

密室殺人って本当にいいですね。トリックが色々とあるので。
隠し扉だったり、逃げ道を作ってどこからか逃げたりとか……・それ以外にも遅発性の毒とかアレルギーもありますし…。

館殺人はほぼ全て読破してるはずなのにこれは読んでなかった~~~。
舞台は丹後半島なので、時間の有るときに行ってみようかなと思います。密室殺人だし、外に出られることも殆ど無かったので、行ってもよく分からないだろうけどね。

プロフィール

はなかな

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

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

この人とブロともになる

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