昨年末に弟が逝ってしまい、例年行っている年賀状(喪中も含む)のスキャンにもあまり力が入らない...
マクロ年画状の機能強化したり、ブログアップ用にWordでマクロを作ったりで時間が掛かった‥‥ ことにしよう...
年賀状をスキャンし表裏で1枚の 年画状.jpg を作る
スキャナーは年末に更新*1 した ScanSnap S1300i。設定は旧の ScanSnap S300を引き継いだので操作の変更はなかったものの、56枚でも辛かった...
Excel住所録のハイパーリンク切れを修正
下図は亡くなった弟の Excel住所録、
年賀状のスキャンは2015年から行っているので、2015年の年賀をクリックすると Windowsフォトビューワーで見られる‥‥ のだが、な、なんとリンク切れ~~~~~
エラーの内容を見ると‥‥ 年画状の保存先が Onedrive になっている...
- 以前、Onedriveをバックアップに使える‥‥ と聞いたので、年画状.jpg をコピーしたことがある。
- その時にハイパーリンクを張り替えた記憶はないが...
- 結局、バックアップは無理だったようで、Onedriveの年画状.jpg は削除した‥‥ ようだが...
Excel住所録に年画状.jpg をハイパーリンクする
年賀状を見ながら、住所録の氏名(差出人)にリンクを張るのだが、亡くなった方等のデータも持っているので、氏名を検索するのはそれなりに大変。そこで、
ようにした。
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("検索するかな1文字を入力してください。", 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
*1:ゴムローラーが劣化し送れなくなった