昨年末に弟が逝ってしまい、例年行っている年賀状(喪中も含む）のスキャンにもあまり力が入らない...
マクロ年画状の機能強化したり、ブログアップ用にWordでマクロを作ったりで時間が掛かった‥‥ ことにしよう...
下図は亡くなった弟の Excel住所録、
年賀状のスキャンは2015年から行っているので、2015年の
年賀をクリックすると
Windowsフォトビューワーで見られる‥‥ のだが、な、なんとリンク切れ～～～～～
エラーの内容を見ると‥‥ 年画状の保存先が Onedrive になっている
...
- 以前、Onedriveをバックアップに使える‥‥ と聞いたので、年画状.jpg をコピーしたことがある。
- その時にハイパーリンクを張り替えた記憶はないが...
- 結局、バックアップは無理だったようで、Onedriveの年画状.jpg は削除した‥‥ ようだが...
ハイパーリンクのアドレスの一部を変更するマクロ ～Replace関数～Excel(エクセル) 2013 マクロ講座
kokodane.com
1.Sub ハイパーリンクのアドレスの一部だけ変更する1()
2.Dim h As Hyperlink
3. For Each h In ActiveSheet.Hyperlinks
4. h.Address = Replace(h.Address, "kokodane", "soredane")
5. Next h
6.End Sub
上記をVBEにコピペし、Onedriveのパスを D:\ に変更，実行して‥‥ 事なきを得た。
年賀状を見ながら、住所録の氏名（差出人）にリンクを張るのだが、亡くなった方等のデータも持っているので、氏名を検索するのはそれなりに大変。そこで、
- ［かな］ボタンを作り、
- かな１文字で検索し、
- 先頭のレコードまでスクロールする
ようにした。
VBAのソースは下記、日数がかなり掛ったが、終わってヤレヤレ...
［かな］ボタンを作る VBA
01.Sub かなボタンを作る()
02.Dim strCell As String
03.
04. With ActiveSheet.Buttons.Add( _
05. Range("B1").Left, _
06. Range("B1").Top, _
07. Range("B1:B1").Width, _
08. Range("B1:B1").Height)
09. .OnAction = "かな検索"
10. .Characters.Text = "かな"
11. End With
12.
13.End Sub
［かな］ボタンクリック時のイベントプロシージャ
01.Sub かな検索()
02.Dim mbTitle As String
03.Dim strKana As String
04.
05. mbTitle = "かな検索/" & ThisWorkbook.Name
06. strKana = InputBox("検索するかな１文字を入力してください。", mbTitle)
07. If strKana = "" Then Exit Sub
08.
09. Columns("B:B").Select
10. Selection.Find(What:=strKana, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
11. xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
12. , MatchByte:=False, SearchFormat:=False).Activate
13. 'アクティブセル画面左上端に表示
14. With ActiveWindow
15. .ScrollRow = ActiveCell.Row
16. .ScrollColumn = ActiveCell.Column
17. End With
18.
19.End Sub
VBAのコードを段落番号付きのテキストにする
当初、メモ帳に貼り付け、VBAで段落番号を付けたものを作った‥‥ が、文字化けが発生！ そこで
- VBAのソースをWordに貼り付け
- 下記を実行する。
- メモ帳が開くので、ブログにコピペする。
これが一番大変で、インストラクターのネタ帳にお世話になった。
01.'引用：インストラクターのネタ帳
02.' ：文字列を一行ずつ行単位で取得するWordマクロ
03.' ：https://www.relief.jp/docs/word-vba-get-text-each-line.html
04.Sub アクティブ文書の文字列を一行ずつ処理する()
05.Dim mbTitle As String
06.Const outFile As String = "C:\Users\YHayashi\Desktop\無題.txt"
07.Dim pg As Page
08.Dim rc As Rectangle
09.Dim ln As Line
10.Dim dsn As Long, keta As Long, cnt As Long
11.Dim outArea As String
12.
13. mbTitle = "/" & ThisDocument.Name
14. keta = InputBox("段落番号の桁数を入力してください", mbTitle, 2)
15. If keta = 0 Then Exit Sub
16.
17. dsn = FreeFile
18. Open outFile For Output As #dsn
19. cnt = 0
20. With ActiveWindow
21. .View.Type = wdPrintView
22. For Each pg In .ActivePane.Pages
23. For Each rc In pg.Rectangles
24. For Each ln In rc.Lines
25. If rc.RectangleType = wdTextRectangle Then
26.' MsgBox ln.Range.Text
27. outArea = ln.Range.Text
28. outArea = Left(outArea, Len(outArea) - 1)
29. cnt = cnt + 1
30. If cnt >= 10 ^ keta Then keta = keta + 1
31. outArea = Right("00000" & cnt, keta) & "." & outArea
32. Print #dsn, outArea
33. End If
34. Next ln
35. Next rc
36. Next pg
37. End With
38. Close #dsn
39. '出力したファイルをメモ帳で開く。
40. LNGAns = Shell("notepad.exe " & outFile, vbNormalFocus)
41. If LNGAns = 0 Then
42. MsgBox "メモ帳の起動に失敗しました。"
43. Exit Sub
44. End If
45.
46.End Sub
さぼっている訳ではない。
