平成23年年賀はがき・年賀切手当選番号

≪年賀状≫
今年も例によって、下2桁順の当選番号表を作った。
下2桁当選番号
02024等(下2ケタ)
492289492等(下6ケタ)
6383633等(下4ケタ)
69694等(下2ケタ)
710224712等(下6ケタ)
804035802等(下6ケタ)
946516941等(下6けた)

作成手順

  1. Excelで当選番号表を作成。(インターネットからコピペ)
  2. 「下2桁」は、“=B2-ROUNDDOWN(B2,-2)” で作成。
  3. 「下2桁」で並び替え、
  4. Wordにコピペ。
  5. はてな形式の」表に、Wordのマクロで変換し、
  6. ブログにコピペ。
  7. ソースを表示し、
  8. <table> のhtmlコードをWordにコピペ。
  9. Word上で、tabを[置換]で削除し、
  10. ブログに戻す。
  11. ブログ上で細かな修正(主に、align)を加える。

Wordのマクロ

Sub カーソルのある表をはてな表に変換する()
'2011/01/05 初版
'2011/01/25 最後にmsgboxを追加。
        '表を文字列に変換する。
    Application.DefaultTableSeparator = "|"
    Selection.Rows.ConvertToText Separator:=wdSeparateByDefaultListSeparator, _
        NestedTables:=True
        '[置換」で“|”を挿入する。
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "|^p|"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
        '文頭に“|”を挿入する。
    Selection.HomeKey Unit:=wdStory
    Selection.TypeText Text:="|"
        '文末に移動し、BackSpace×2
    Selection.EndKey Unit:=wdStory
    Selection.TypeBackspace
    Selection.TypeBackspace
    MsgBox "変換が終わりました。" & vbCrLf & vbCrLf _
            & "項目行には「*」を付けてください。", vbInformation, "カーソルのある表をはてな表に変換する"
        
End Sub

Sub タブを削除する()
'2011/01/16 初版

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub