如何在EXCEL表格中自动生成目录

在使用 Excel 的时候经常会遇到需要创建目录的情况。如果工作表不多的话还好,表一多创建起来就比较麻烦。所以这里就记录一个用宏自动创建目录的方法。

按Alt+F11,在弹出的对话框中点插入选择模块,然后把下面的代码复制到模块中

Sub mulu()
    On Error GoTo Tuichu
    Dim i As Integer
    Dim ShtCount As Integer
    Dim SelectionCell As Range
    ShtCount = Worksheets.Count
    If ShtCount = 0 Or ShtCount = 1 Then Exit Sub
    Application.ScreenUpdating = False
    For i = 1 To ShtCount
        If Sheets(i).Name = "目录" Then
            Sheets("目录").Move Before:=Sheets(1)
        End If
    Next i
    If Sheets(1).Name <> "目录" Then
        ShtCount = ShtCount + 1
        Sheets(1).Select
        Sheets.Add
        Sheets(1).Name = "目录"
    End If
    Sheets("目录").Select
    Columns("B:B").Delete Shift:=xlToLeft
    Application.StatusBar = "正在生成目录…………请等待!"
    For i = 2 To ShtCount
        ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2), Address:="", SubAddress:= _
                                   "'" & Sheets(i).Name & "'!R1C1", TextToDisplay:=Sheets(i).Name
    Next
    Sheets("目录").Select
    Columns("B:B").AutoFit
    Cells(1, 2) = "目录"
    Set SelectionCell = Worksheets("目录").Range("B1")
    With SelectionCell
        .HorizontalAlignment = xlDistributed
        .VerticalAlignment = xlCenter
        .AddIndent = True
        .Font.Bold = True
        .Interior.ColorIndex = 34
    End With
    Application.StatusBar = False
    Application.ScreenUpdating = True
Tuichu:
End Sub

复制完成后按F5运行即可,如果后期对表名做了修改,只需要重新进入这个界面按F5运行刷新下目录即可。

如果是在 Mac 下,打开 Excel,选择顶部的视图,查看宏。在打开的窗口中随便写一个宏名称,点击下方的 + 创建一个新的宏,然后将上面的代码粘贴进去执行即可。

EXCEL、WORD、POWERPOINT+VBA利用CDO组件发送邮件

前几天学习宏病毒的时候用到了,顺手记录一下~
Sub EMAIL()
Dim cm As Variant
Set cm = CreateObject(“CDO.Message”) ‘创建对象
cm.From = “” ‘设置发信人的邮箱
cm.To = “” ‘设置收信人的邮箱
cm.Subject = “主题:邮件发送试验” ‘设定邮件的主题
‘cm.TextBody = “宝坻一中信息中心/” ‘使用文本格式发送邮件
cm.HtmlBody = “邮件发送试验^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^” ‘使用html格式发送邮件
‘cm.AddAttachment Server.MapPath(“test.zip”)
‘发送附件test.zip。
stUl = “http://schemas.microsoft.com/cdo/configuration/” ‘微软服务器网址
With cm.Configuration.Fields
.Item(stUl & “smtpserver”) = “smtp.bdyz.net” ‘SMTP服务器地址
.Item(stUl & “smtpserverport”) = 25 ‘SMTP服务器端口
.Item(stUl & “sendusing”) = 2 ‘发送端口
.Item(stUl & “smtpauthenticate”) = 1 ‘
.Item(stUl & “sendusername”) = “changxi” ‘发送方邮箱名称
.Item(stUl & “sendpassword”) = “*************” ‘发送方邮箱密码
.Update
End With

cm.Send ‘最后当然是执行发送了
Set cm = Nothing
‘发送成功后即时释放对象
End Sub