『鹭千』核苷酸碱基序列编号能手v1.0的开发

楼主 0Mouse	『鹭千』核苷酸碱基序列编号能手v1.0的开发 ====== 工具简介 ====== 【用途】快速对几千个由AGCT组成的字母串（专业术语：核苷酸碱基序列）进行逢十编号，即实现由图1所示效果转变为图2所示效果。图1：初始效果图2：预期效果：图1与图2的区别： 1. 编号位置不同：图1在字母左侧，图2在字母上方； 2. 编号间隔字母（专业术语：碱基）数不同：图1间隔数为49，即每50个字母编一个号；图2间隔数为9，即每逢10个字母编一个号； 3. 每行字母数不同：图1每行50个字母，图2每行60个字母； 4. 起始编号不同：图1从1开始，50为步长；图2从10开始，10为步长； 5. 对齐方式不同：图1所有编号的个位数对齐，图2编号与整十的字母对齐。【预览图】图3：工具预览图【使用要求】 1. 运行工具前请先关闭Word和Excel程序； 2. 如安装了NOD32杀毒软件，请先暂停或关闭，否则会弹出威胁警报（图3）。图4：NOD32报毒【使用方法动画演示】图5：工具使用方法动画演示【开发所用软件及其在本工具开发中的用途】 Excel 2003：借助vba代码实现预期功能； Word 2003：存放工具处理结果文件； Illustrator CS3：设计启动显示画面和启动程序图标底图； Photoshop CS3：美化启动显示画面和启动程序图标； Visual Basic 6.0：编写启动程序，避开选择“禁用宏”和“启用宏”的环节； Format Factory（格式工厂）：将.bmp格式的图片转换成.ico格式的系统图标。（下接2楼）
2楼 0Mouse	（上接1楼）『鹭千』核苷酸碱基序列编号能手v1.0 最终文件下载：『鹭千』核苷酸碱基序列编号能手v1.0.rar （下接3楼）
3楼 0Mouse	（上接2楼）==== 工具开发流程 ====第一阶段：功能代码编写启动Excel后，按下Alt+F11，双击左侧的“ThisWorkbook”，在弹出的代码窗口中粘贴代码1，再依次单击“插入”-“模块”，在弹出的代码窗口中粘贴代码2，按下Ctrl+S，选择保存位置，填写文件名（可自定义），如numsysfil.xls，单击“保存”按钮。（注意：执行保存后，不要关闭文档！）代码1： Private Sub Workbook_Open() Application.Visible = False Dim rq As Date rq = #11/13/2014# If rq > Date And rq - Date <= 10 Then MsgBox "本工具将于 " & rq & " 到期！", vbOKOnly, "敬告用户" Call AutoCode GoTo 200 ElseIf rq = Date Then MsgBox "本工具今日到期！", vbOKOnly, "敬告用户" GoTo 100 ElseIf rq < Date Then MsgBox "本工具已于 " & rq & " 到期！", vbOKOnly, "敬告用户" GoTo 100 Else Call AutoCode GoTo 200 End If 100: Application.DisplayAlerts = False With ActiveWorkbook .ChangeFileAccess xlReadOnly Kill .FullName If Workbooks.Count > 1 Then ActiveWorkbook.Close False ElseIf Workbooks.Count = 1 Then Application.Quit ActiveWorkbook.Close False End If End With Application.DisplayAlerts = True 200: Application.Visible = True Application.Quit End Sub 代码2： Sub HideForm() Unload UserForm1 End Sub Sub AutoCode() Application.Visible = False UserForm1.Show Application.DisplayStatusBar = True Application.StatusBar = " 『鹭千』2011作品 QQ:29947277 E-mail:shaoqian9527@163.com" ThisWorkbook.Sheets("Data").Cells.ClearContents On Error GoTo 20 10: Dim fil, fn ChDrive Left(ThisWorkbook.Path, 1) ChDir ThisWorkbook.Path fil = Application.GetOpenFilename("文本文件,.txt", 1, "请选择核酸碱基序列所在的文本文件", MultiSelect:=True) If fil = False Then If MsgBox("您没有选择任何文件，单击“重试”按钮重新选择，单击“取消”按钮退出系统。", vbInformation + vbRetryCancel, "提示") = vbRetry Then GoTo 10 Else GoTo 30 End If End If 20: Dim tcol tcol = InputBox("您希望每行放置多少个碱基？" & Chr(10) & Chr(10) & " 50还是60？", "输入提示", 60) If tcol = "" Then If MsgBox("必须输入相应数字，单击“重试”按钮重新输入，单击“取消”按钮退出系统。", vbInformation + vbRetryCancel, "提示") = vbRetry Then GoTo 20 Else GoTo 30 End If ElseIf tcol <> 50 And tcol <> 60 Then If MsgBox("每行放置的碱基数只能是“50”或“60”，单击“重试”按钮重新输入，单击“取消”按钮退出系统。", vbInformation + vbRetryCancel, "提示") = vbRetry Then GoTo 20 Else GoTo 30 End If End If On Error GoTo 30 Application.ScreenUpdating = False Dim wdapp As Object Set wdapp = CreateObject("word.application") Dim i As Integer For i = 1 To UBound(fil) Dim fs As Object Dim fd, a, b Set fs = CreateObject("Scripting.FileSystemObject") Set fd = fs.OpenTextFile(fil(i)) a = fd.readall fd.Close With CreateObject("vbscript.regexp") .Global = True .Pattern = "[^AGCT]" b = .Replace(a, "") End With ThisWorkbook.Sheets("Data").Activate Dim x As Integer, y As Integer For x = 2 To WorksheetFunction.RoundUp(Len(b) / tcol, 0) 2 Step 2 For y = 1 To tcol \ 10 Cells(x, y) = Mid(b, y * 10 - 9 + (x \ 2 - 1) * tcol, 10) If Len(Cells(x, y)) = 10 Then Cells(x - 1, y) = y * 10 + (x \ 2 - 1) * tcol ElseIf Len(Cells(x, y)) > 0 And Len(Cells(x, y)) < 10 Then Cells(x, y) = Cells(x, y) & String(10 - Len(Cells(x, y)), " ") End If Next y Next x With Sheets("Data").Range("A1").Resize(WorksheetFunction.RoundUp(Len(b) / tcol, 0) * 2, tcol \ 10) .HorizontalAlignment = xlRight .Font.Name = "Courier New" .Font.Size = 10 End With Dim wddoc As Object Set wddoc = wdapp.Documents.Add("Normal", False, 0) ThisWorkbook.Sheets("Data").Range("A1").Resize(WorksheetFunction.RoundUp(Len(b) / tcol, 0) * 2, tcol \ 10).Copy wdapp.Selection.Paste wdapp.Selection.Tables(1).AutoFitBehavior (2) wddoc.SaveAs Replace(fil(i), ".txt", ".doc") wddoc.Close ThisWorkbook.ActiveSheet.UsedRange.ClearContents Next i Application.Quit Set Object = Nothing Application.ScreenUpdating = True MsgBox "您选择的【" & UBound(fil) & "】个碱基序列编号完毕！" & vbCrLf & "感谢使用核苷酸碱基序列编号能手v1.0！" & vbCrLf & vbCrLf & " 『鹭千』2011作品" & vbCrLf & vbCrLf & " QQ:29947277 " & vbCrLf & " E-mail:shaoqian9527@163.com", vbInformation, "致谢" 30: ThisWorkbook.Save End Sub （下接4楼）
4楼 0Mouse	（上接3楼）第二阶段：文件美化包装 1. 启动显示画面设计采用Adobe Illustrator CS3设计启动显示画面底图，“导出”为.jpg格式的图片（图6），使用Adobe Photoshop CS3打开，为其添加文字和特效，保存（图7）。详细制作过程：略。图6：启动显示画面底图图7：启动显示画面最终效果图 2. 启动用户窗体制作激活第一阶段保存的numsysfil.xls的代码窗口，依次单击“插入”-“用户窗体”，再按下F4，弹出用户窗体的属性窗口，在其“按字母序”选项卡的左侧找到“Picture”选项（图8），单击该选项右侧按钮，弹出“加载图片”对话框，选择步骤1保存的启动显示画面最终效果图片，单击“打开”按钮，再单击右侧UserForm1窗口，拖动调整窗体长宽与加载图片一致。图8：UserForm1属性窗口的“Picture”属性单击窗口左侧“UserForm1”，单击鼠标右键，选择“查看代码”，在弹出的代码窗口中粘贴代码3，保存，退出Excel程序。代码3： Private Sub UserForm_Initialize() '设置窗体标题 Me.Caption = "『鹭千』核苷酸碱基序列编号能手v1.0" '5秒钟后调用HideForm Application.OnTime Now + TimeValue("00:00:05"), "HideForm" End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '禁止使用窗体关闭按钮退出 If CloseMode = 0 Then Cancel = True End Sub （下接5楼）
5楼 0Mouse	（上接4楼） 3. 启动程序图标设计采用Adobe Illustrator CS3设计启动程序图标底图，“导出”为.jpg格式的图片，使用Adobe Photoshop CS3打开，进行相应调整后“另存为”.bmp格式的图片（图10）。注意：另存为“BMP选项”对话框中的“深度”只能选择“16位”（图11）。详细制作过程：略。图9：启动程序图标效果图图9 启动程序图标效果图.rar 图10：“BMP选项”对话框 4. 启动程序图标格式转换图11：图片格式转换动画演示图12：启动程序图标.ico格式效果图图12 启动程序图标.ico格式效果图.rar 注意：预期图标的大小必须设置为16×16像素（图13）。图13：预期ico图标大小设置（下接6楼）
6楼 0Mouse	（上接5楼） 5. 启动程序文件制作目的：避开选择“禁用宏”和“启用宏”的操作。制作启动程序所需文件：制作启动程序所需文件.rar 图14：启动程序文件制作动画演示 6. 伪装Excel文件将之前保存的Excel文件numsysfil.xls的扩展名改为“.dll”。制作完毕！ ==== 致谢 ==== 本工具vba代码的编写得到了K哥（exceltip社区用户名：kevinchengcw）和弦月（exceltip社区用户名：xmyjk）的耐心指点，启动程序文件的制作参考了ExcelHome会员TGB发表的帖子《[原创]把EXCEL.xls变成.dll超简单！》（http://club.excelhome.net/forum.php?mod=viewthread&tid=231705），在此向三位表示感谢！
7楼 lrlxxqxa	先收藏了
8楼 wise	这东西不错，值得一读，申请精华不为过。支持精华。
9楼 dawin2046	强悍。
10楼 lrlxxqxa	小千越来越强大了，佩服
11楼 apolloh	学习！
12楼 bensonlei	不错, 学以致用!
13楼 xmyjk	小千进步好大的，没V没多久，有这个成效了，另外也支持原创！谢谢分享并学习了。
14楼蝈蝈xlz	支持并收藏了！