Sub プライマー情報表示マクロ()
    X = Len(Selection.Text)
    For i = 1 To X
        Select Case Mid$(Selection.Text, i, 1)
        Case "A"
        N = N + 1
        AT = AT + 1
        MW = MW + 313.2
        Case "T"
        N = N + 1
        AT = AT + 1
        MW = MW + 304.2
        Case "G"
        N = N + 1
        GC = GC + 1
        MW = MW + 329.2
        Case "C"
        N = N + 1
        GC = GC + 1
        MW = MW + 289.2
        End Select
    Next i
    If N = 0 Then MsgBox ("塩基配列を選択してください")
    If N <= 18 Then
        melt = AT * 2 + GC * 4
        MsgBox ("プライマーの長さは " & N & " 塩基です．" & Chr(13) _
        & "" & Chr(13) _
        & "Ａ+Ｔ は " & Format(AT) & " 塩基です．" & Chr(13) _
        & "" & Chr(13) _
        & "Ｇ+Ｃ は " & Format(GC) & " 塩基です．" & Chr(13) _
        & "" & Chr(13) _
        & "ＧＣ比は " & Format(100 * GC / N, "fixed") & "％です．" & Chr(13) _
        & "" & Chr(13) _
        & "ＴＭ は " & Format(melt) & "℃です．" & Chr(13) _
        & "" & Chr(13) _
        & "分子量は " & Format(MW) & " Da です．")
    End If
    If N > 18 Then
        melt = 81.5 + 16.6 * Log(0.15) / Log(10) + 0.41 * ((100 * GC) / N) - (600 / N)
        MsgBox ("プライマーの長さは " & N & " 塩基です．" & Chr(13) _
        & "" & Chr(13) _
        & "Ａ+Ｔ は " & Format(AT) & " 塩基です．" & Chr(13) _
        & "" & Chr(13) _
        & "Ｇ+Ｃ は " & Format(GC) & " 塩基です．" & Chr(13) _
        & "" & Chr(13) _
        & "ＧＣ比は " & Format(100 * GC / N, "fixed") & "％です．" & Chr(13) _
        & "" & Chr(13) _
        & "ＴＭ は " & Format(melt, "fixed") & "℃です．" & Chr(13) _
        & "" & Chr(13) _
        & "分子量は " & Format(MW) & " Da です．")
    End If
End Sub


Sub相補鎖変換マクロ()
Selection.Font.Italic = wdToggle
With Selection.Find
    .ClearFormatting
    .Font.Italic = True
    .Text = "A"
    With .Replacement
        .ClearFormatting
        .Font.Italic = False
        .Text = "T"
    End With
    .Execute Format:=True, Replace:=wdReplaceAll
End With
With Selection.Find
    .ClearFormatting
    .Font.Italic = True
    .Text = "T"
    With .Replacement
        .ClearFormatting
        .Font.Italic = False
        .Text = "A"
    End With
    .Execute Format:=True, Replace:=wdReplaceAll
End With
With Selection.Find
    .ClearFormatting
    .Font.Italic = True
    .Text = "G"
    With .Replacement
        .ClearFormatting
        .Font.Italic = False
        .Text = "C"
    End With
    .Execute Format:=True, Replace:=wdReplaceAll
End With
With Selection.Find
    .ClearFormatting
    .Font.Italic = True
    .Text = "C"
    With .Replacement
        .ClearFormatting
        .Font.Italic = False
        .Text = "G"
    End With
    .Execute Format:=True, Replace:=wdReplaceAll
End With
End Sub

Sub 相補鎖表示マクロ１()
    With ActiveDocument.PageSetup
        .LayoutMode = wdLayoutModeDefault
    End With
    Selection.Find.ClearFormatting
    With Selection.Find
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Font.Color = wdColorRed
    Selection.Copy
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    SP = Len(Selection.Text)
    If Selection.Type = wdSelectionIP Then
        Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
        Selection.Find.Execute FindText:="^p", ReplaceWith:="^p^p"
        Selection.MoveRight Unit:=wdWord, Count:=1
        Selection.MoveLeft
        Selection.Paste
        Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
        Selection.Font.Color = wdColorLightBlue
        Application.Run MacroName:="相補鎖変換マクロ"
        Selection.MoveRight Unit:=wdWord, Count:=1
        Selection.TypeText Text:="-5"
        Exit Sub
    End If
    For i = 1 To SP
        Select Case Mid$(Selection.Text, i, 1)
        Case "^p"
        N = N
        Case "A"
        N = N + 1
        Case "T"
        N = N + 1
        Case "G"
        N = N + 1
        Case "C"
        N = N + 1
        Case "  "
        N = N + 1
        Case "1"
        N = N + 1
        Case "2"
        N = N + 1
        Case "3"
        N = N + 1
        Case "4"
        N = N + 1
        Case "5"
        N = N + 1
        Case "6"
        N = N + 1
        Case "7"
        N = N + 1
        Case "8"
        N = N + 1
        Case "9"
        N = N + 1
        Case "0"
        N = N + 1
        End Select
    Next i
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Find.Execute FindText:="^p", ReplaceWith:="^p^p"
    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.MoveLeft
    For i = 1 To N
    Selection.TypeText Text:=" "
    Next i
    Selection.Paste
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Font.Color = wdColorLightBlue
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    Application.Run MacroName:="相補鎖変換マクロ"
    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.TypeText Text:="-5"
End Sub


Sub 相補鎖表示マクロ２()
    With ActiveDocument.PageSetup
        .LayoutMode = wdLayoutModeDefault
    End With
    Selection.Find.ClearFormatting
    With Selection.Find
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Font.Color = wdColorGray25
    Selection.MoveUp Unit:=wdParagraph, Count:=1
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorGray25
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    Selection.Font.Color = wdColorAutomatic
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Font.Color = wdColorRed
    Selection.Copy
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    SP = Len(Selection.Text)
    If Selection.Type = wdSelectionIP Then
        Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
        Selection.Find.ClearFormatting
        With Selection.Find
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = False
            .MatchFuzzy = False
        End With
        Selection.Find.Execute FindText:="^p", ReplaceWith:="^p^p"
        Selection.MoveRight Unit:=wdWord, Count:=1
        Selection.MoveLeft
        Selection.Paste
        Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
        Selection.Font.Color = wdColorLightBlue
        Application.Run MacroName:="相補鎖変換マクロ"
        Selection.MoveRight Unit:=wdWord, Count:=1
        GoTo Line1
    End If
    For i = 1 To SP
        Select Case Mid$(Selection.Text, i, 1)
        Case "^p"
        N = N
        Case "A"
        N = N + 1
        Case "T"
        N = N + 1
        Case "G"
        N = N + 1
        Case "C"
        N = N + 1
        Case "  "
        N = N + 1
        Case "1"
        N = N + 1
        Case "2"
        N = N + 1
        Case "3"
        N = N + 1
        Case "4"
        N = N + 1
        Case "5"
        N = N + 1
        Case "6"
        N = N + 1
        Case "7"
        N = N + 1
        Case "8"
        N = N + 1
        Case "9"
        N = N + 1
        Case "0"
        N = N + 1
        End Select
    Next i
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Find.ClearFormatting
    With Selection.Find
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute FindText:="^p", ReplaceWith:="^p^p"
    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.MoveLeft
    For i = 1 To N
    Selection.TypeText Text:=" "
    Next i
    Selection.Paste
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Font.Color = wdColorLightBlue
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    Application.Run MacroName:="相補鎖変換マクロ"
    Selection.MoveRight Unit:=wdWord, Count:=1
Line1:
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorGray25
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    Selection.Font.Color = wdColorAutomatic
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorGray25
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    Selection.MoveRight
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Font.Color = wdColorRed
    Selection.Copy
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.Paste
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Font.Color = wdColorLightBlue
    Application.Run MacroName:="相補鎖変換マクロ"
    Selection.MoveRight
    Selection.TypeText Text:="-5"
End Sub


Sub 相補鎖表示マクロ()
    With ActiveDocument
        .Compatibility(wdDontBalanceSingleByteDoubleByteWidth) = True
    End With
    Parag = Selection.Paragraphs.Count
    If Parag = 1 Then
        Application.Run MacroName:="相補鎖表示マクロ１"
        Exit Sub
    End If
    If Parag = 3 Then
        Application.Run MacroName:="相補鎖表示マクロ２"
        Exit Sub
    End If
End Sub


Sub 塩基配列リバース表示マクロ()
' Reverse Macro
' Macro created by Takeshi Suzuki
    Selection.Font.Color = wdColorBlack
    Temp = Selection
    Options.ReplaceSelection = True
    Selection.TypeText "" & StrReverse(Temp) & ""
End Sub