核酸序列word(vba)一键排版--688IT编程网

先看结果图：

编辑之前：

编辑之后：

首先打开vba，将下面的vba代码粘贴到Normal→模块→NewMacros中（不同电脑可能不同）然后保存。

具体使用过程：

第一，单独新建的word文件，将序列复制到word中，然后全选；

第二，调出Visual BasicB,选择运行宏；在此之前请将宏安全性调到最低；

第三，选择“Word一键排版核酸序列()”，运行然后选择“添加编号”，finish。

VBA代码如下：

Sub Word一键排版核酸序列()

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

'清除换行符

With Selection.Find

.Text = "^p"

.Replacement.Text = ""

replaceall() .Forward = True

.Wrap = wdFindContinue '不弹出窗口提醒，wdFindAsk弹出窗口提醒

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchByte = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Selection.Find.Execute Replace:=wdReplaceAll 'wdReplaceNone表示不替换，wdReplaceOne表示替换一个

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

'每十个碱基添加一个空格

With Selection.Find

.Text = "??????????"

.Replacement.Text = "^& "

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchByte = False

.MatchAllWordForms = False

.MatchSoundsLike = False

.MatchWildcards = True

End With

Selection.Find.Execute Replace:=wdReplaceAll

Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

'两端对齐，字体为宋体

With Selection.Find

.Text = "??????????"

.Replacement.Text = "^& "

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchByte = False

.MatchAllWordForms = False

.MatchSoundsLike = False

.MatchWildcards = True

End With

Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify

Selection.Font.Name = "宋体"

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = _

"??????????????????????????????????????????????????????????????????"

.Replacement.Text = "^&^p"

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchByte = False

.MatchAllWordForms = False

.MatchSoundsLike = False

.MatchWildcards = True

End With

Selection.Find.Execute Replace:=wdReplaceAll

'以上代码为录制宏得到，只是将.Wrap = wdFindAsk 改为 .Wrap = wdFindContinue用于不弹出窗口提醒

'以下代码添加编号，手工编写

Dim pa As Paragraph

Dim i As Integer

i = 1

For Each pa In ActiveDocument.Paragraphs

If (i - 1) * 60 + 1 < 10 Then