VBA/Excel-实例系列-01-工作簿目录生成

系统：Windows 10
软件：Excel 2010

• 这个系列说一些使用Excel/VBA具体的一些实例

• 今天讲讲如何使用VBA代码自动为工作簿建立目录

Part 1：为什么整这个？

• 不知大家有无遇到这样的情况，手头上有一个含有很多工作表的工作簿，由于工作需要，需要在这些工作表中查找信息或者操作
  

• 着实心累，有一天突发奇想，能不能自动建立一个目录工作表，建立超链接，可以增加一些注释，想点哪个工作表点哪一个

• 又想了下，能不能整成通用型，下次有新的工作表也一样可以用，类似于一个小工具

• 好吧，实际的需求是促进技术发展的大大动力，希望各位看官，也有这样的想法，遇见麻烦重复的事，多想想，能不能自动化

Part 2：框架搭建

1. 需求：建议一个工作表“目录”，主要内容为四列，包括：序号，含义，工作表名称，超链接

• 由于想其它工作表也可以使用，所以把所有代码放于一个模块中，其它工作表使用直接导入即可

• 对于用户的操作为：导入模块bas文件，运行，删除该模块，保存，工作完成

2. 代码逻辑过程

• 检查当前工作簿是否含有目录工作表，有则提醒，并停止程序（这种情况下，用户需手动更改原目录工作表为其它名称）

• 若当前工作簿无“目录”工作表，则新建目录工作表，并将该工作表位置放于首位

• 循环当前工作簿所有工作表，获取名称，置于目录工作表C列中，并建立超链接，放置于D列，A列设置序号，B列可写一下对工作表的注释
  

• 调整一下单元格格式大小

3. 代码完成后，导出为模块bas文件，其余用户依然可用

效果图

Part 3：代码部分

Sub 各工作表名称()    Rem>>\该程序会新建一个工作表“目录”，并置于第一个工作表位置    Rem>>\获得当前工作簿除“目录”工作表以外的工作表名称    Rem>>\工作表名称存放于“目录”工作表C列，从第2行开始    Rem>>\“目录”工作表A列，存放序号；B列存放“含义”；D列存放超链接    Rem>>\最多可以获取9999个工作表目录    Rem>>    For Each sht In ThisWorkbook.Worksheets        shtName = sht.Name        If shtName = '目录' Then            MsgBox '本工作簿已存在《目录》工作表，请确认' & Chr(13) & Chr(10) _            & '请手动删除该工作表或者对其更名，将新建一个新的《目录》工作表'            End        End If    Next    '新建目录    ThisWorkbook.Sheets(1).Select    Sheets.Add    ActiveSheet.Name = '目录'    Set shtContent = ThisWorkbook.Worksheets('目录')    shtContent.Move before:=ThisWorkbook.Sheets(1)    shtContent.Cells.ClearContents    shtContent.Range('A1') = '序号'    shtContent.Range('B1') = '含义'    shtContent.Range('C1') = '工作表名称'    shtContent.Range('D1') = '超链接'    strNewWbName = ThisWorkbook.Name    For Each sht In ThisWorkbook.Worksheets        shtName = sht.Name        If shtName <> '目录' Then            For intI = 2 To 10000 Step 1                If shtContent.Cells(intI, 'C') = '' Then                    shtContent.Cells(intI, 'A') = intI - 1                    shtContent.Cells(intI, 'C') = shtName                    strHyperLink = 'HYPERLINK(' & Chr(34) & '[' & strNewWbName & ']' & _                    shtName & '!A1' & Chr(34) & ',' & Chr(34) & shtName & Chr(34) & ')'                    shtContent.Cells(intI, 'D') = '=' & strHyperLink                    Exit For                End If            Next        End If    Next    '调整单元格    shtContent.Rows.AutoFit    shtContent.Columns.AutoFit    shtContent.Columns('B:B').ColumnWidth = 20    With shtContent.Cells        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlCenter        .WrapText = False        .Orientation = 0        .AddIndent = False        .IndentLevel = 0        .ShrinkToFit = False        .ReadingOrder = xlContext        .MergeCells = False    End With End Sub

代码截图

Part 4：部分代码解读

• shtContent.Move before:=ThisWorkbook.Sheets(1)，将工作表置于工作簿第一个

• 超链接函数HYPERLINK，用法为HYPERLINK(超链接地址，显示的名字)，例如=HYPERLINK('[test.xlsx]Sheet1!A1','Sheet1')

• 超链接地址：工作簿 工作表 单元格，再加上双引号，中括号，感叹号，例“[test.xlsx]Sheet1!A1”

• shtContent.Cells.HorizontalAlignment = xlCenter表示所有单元格横向居中对齐

以上为本次的学习内容，下回见

本文为原创作品，如若转载请标明出处，如发现有错误，欢迎留言指出

---