VBA如何实现在excel中审批和自动编码

[蜗牛学编程]

请问一下各位大神，如果我想在EXCEL中实现以下功能该怎么编写这代码：
1，如果想在excel中进行审批，设立一个“approve”和“reject”的按钮，能分别在range（"B2“）中显示”approve“或者"reject"。
2，如果有十个人，希望审批人完成审批后，他的名字是黑色，如果未完成，则是红色，容易辨识。并且系统每隔一天都会自动给未完成审批的人员自动发邮件（outlook）。
3，想每次打开同一个excel，在另存为后，在固定的单元格，例如B5能自动进行编码。譬如第一次保存是001，第二次打开保存后就是002。保存十份文件，每份文件的B5都能自动按顺序编序，而且文件名也能和它保持一致。
刚开始自学VBA，完全是小白，在尝试优化自己的工作内容。希望能得到大神们的指点。
感激不尽哈

[milaoshu1020]

1.按钮要用VBA生成吗?还是直接放在上面就行?
2.十个人的名字显示在哪里?怎么输入?发邮件的话是什么时间发?邮件的内容是什么?使用计划任务是否可行?
3.B5按顺序编序是什么意思?文件名就是001.xls,002.xls...还是别的什么样的?

[蜗牛学编程]

1，按钮的话我自己插入就行，做两个按钮，一个approve,，一个reject，分别链接到宏命令即可。就是不知道这宏该怎么写，能实现审批的功能。 2，十个人是自己设定，譬如说十个单元格，每个单元格就是一个人的邮箱，这个在填写时由填写人输入即可。系统发邮件的VBA已写完了，就是自动发邮件给这十个人，提醒他们要去审批。收件人打开这excel，进行审批。完成审批的话就是黑色，未完成审批的就会是红色。 3，在单元格B5中显示的就是001，002.。。。。，然后文件名就是001.xls，002xls。

引用 1 楼 milaoshu1020 的回复:

1.按钮要用VBA生成吗?还是直接放在上面就行? 2.十个人的名字显示在哪里?怎么输入?发邮件的话是什么时间发?邮件的内容是什么?使用计划任务是否可行? 3.B5按顺序编序是什么意思?文件名就是001.xls,002.xls...还是别的什么样的?

[milaoshu1020]

你的意思是弹出一个输入框,输入自己的邮件地址,然后在完成审批后把自己的邮件地址由红色变成黑色?

[蜗牛学编程]

是我没描述清楚吗？提报人写由谁来审批，VBA发邮件给审批人，审批人审批前，邮箱名一直是红色的，审批完后自动变成黑色。这逻辑不难理解吧

[milaoshu1020]

怎么知道审批的人是哪个邮件地址呢?
通过系统账号还是手动输入或者手动选择?

[milaoshu1020]

是用这个吗?

[milaoshu1020]

写好了,基本完成你的要求,但只保留了1个文件,而没有保留10个文件,因为不知道这10个文件的相互关系如何;
打开的时候会要求输入邮件地址,如果点击取消则不会修改对应地址的颜色;
发邮件的话需要用到计划任务和你有的发邮件代码,这里就没写;

主要代码如下:
ThisWorkbook

Option Explicit

Private fso As New FileSystemObject
Private mblnSaving As Boolean
Private mstrEmail As String
Public mintRow As Integer

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Me.Saved Or SaveAsUI Or mblnSaving Then
        Exit Sub
    End If
    
    If Not IsNumeric(Range("B5")) Then
        Range("B5") = "001"
    Else
        Range("B5") = Format(Range("B5") + 1, "000")
    End If
    
    Dim strOldPath As String
    strOldPath = Me.FullName
    
    Dim strDir As String
    strDir = fso.GetParentFolderName(strOldPath)
    
    Dim strNewName As String
    strNewName = Range("B5") & ".xlsm"
    
    Dim strNewPath As String
    strNewPath = fso.BuildPath(strDir, strNewName)
    
    mblnSaving = True
    Me.SaveAs strNewPath
    fso.DeleteFile strOldPath, True
    mblnSaving = False
    
    Cancel = True
End Sub

Private Sub Workbook_Open()
    mblnSaving = False
    Do
        mstrEmail = InputBox("输入你的E-MAIL:")
        If mstrEmail = "" Then
            mintRow = 0
            Exit Do
        End If
        
        Dim i As Integer
        For i = 1 To 10
            If StrComp(Cells(i, 7), mstrEmail, vbTextCompare) = 0 Then
                mintRow = i
                Exit Do
            End If
        Next
        
        MsgBox "您的Email不在邮件列表中!", vbExclamation
    Loop
End Sub

模块1

Option Explicit

Sub approve_Click()
    Range("B2") = "approve"
    If ThisWorkbook.mintRow > 0 Then
        Cells(ThisWorkbook.mintRow, 7).Font.Color = vbBlack
    End If
End Sub

Sub reject_Click()
    Range("B2") = "reject"
    If ThisWorkbook.mintRow > 0 Then
        Cells(ThisWorkbook.mintRow, 7).Font.Color = vbBlack
    End If
End Sub

运行示例:


下载地址:
链接：https://pan.baidu.com/s/1ATZQyzQ_8oeOXctQsrH2Ew
提取码：jzcp

[蜗牛学编程]

引用 4 楼 milaoshu1020 的回复:

是用这个吗?

手敲就好啦。都是公司人员，肯定知道该给谁发

[蜗牛学编程]

感谢，我先好好消化一下 ^_^

[蜗牛学编程]

看来是我描述的有问题，让您误会啦。 我的意思，譬如我提报一个审批单子，给QA、技术部和Production三个部门的A、B、C三名人员审批。发送邮件的代码已经写好，按另外按钮就能发给他们。 而A、B、C人员收到邮件后，分别按approve和Reject，则审批结果分别显示在他们对应的栏位。 我今天想了一个逻辑，就是按Approve键，会在E8显示Approve结果，同时C8会自动将A的名字加粗并显示绿色。代码如下。 现在问题是，B和C人员按这两按钮，仍然只会改变E8和C8的结果。我该如何修改代码，让他们能分别对应到E11/C11和E14/C14呢？也就是，这按钮改变的是接收人员邮箱相对应的单元格，而不是固定的单元格。 另外，能不能让C8显示的不是邮箱，而是邮箱人名代号（譬如说在企业里，A的邮箱是[e-mail]，但希望显示的是A8）。或者这A点击完Approve后，在F8显示出A8？ 多谢~ Sub approve() Range("E8") = "Approve" If Range("E8") = "Approve" Then Range("C8").Font.FontStyle = "加粗" Range("C8").Interior.ColorIndex = 4 End If End Sub

[蜗牛学编程]

上张图有问题，应该是这个。

[milaoshu1020]

那么在打开工作簿时提示输入当前用户的邮件地址或者用户名是否正确呢?
如果是正确的做法的话,那么就好办了,可以很容易地找到对应的位置并设置格式和颜色;
如果不正确,你怎么知道当前操作Excel表格的用户是谁呢?
还有你同时发给3个人?还是先后发送?
如果是同时发送的话,就涉及到一个内容同步的问题,即,每个人都有一份自己的xlsm文件,这就可能需要asp或者outlook来解决;
如果是先后发送,那就没有问题了,一个人点approve/reject后再发送给其他人,这个很容易实现;

[milaoshu1020]

至于显示用户名代替邮箱的问题,可以这样:
写一个函数,输入是邮箱地址,输出是用户名;
然后再在单元格中调用这个函数:
=func("[e-mail]")
显示的内容为"A";

或者,如果邮箱@后边的地址都是一样的话,那么直接填写邮箱用户名A也可以,程序中自动加后缀就行了;

[蜗牛学编程]

引用 12 楼 milaoshu1020 的回复:

那么在打开工作簿时提示输入当前用户的邮件地址或者用户名是否正确呢? 如果是正确的做法的话,那么就好办了,可以很容易地找到对应的位置并设置格式和颜色; 如果不正确,你怎么知道当前操作Excel表格的用户是谁呢? 还有你同时发给3个人?还是先后发送? 如果是同时发送的话,就涉及到一个内容同步的问题,即,每个人都有一份自己的xlsm文件,这就可能需要asp或者outlook来解决; 如果是先后发送,那就没有问题了,一个人点approve/reject后再发送给其他人,这个很容易实现;

是这样，我们以前也有这么一个VBA系统，但现在负责人已经离职了，我想重新做一个，类似功能的。 C列的邮箱是我提报时填写，发给的人员邮箱地址。他们收到后不需要输入自己的邮箱地址，而是直接从邮件中打开EXCEL，点Approve或Reject，然后他们的C列的邮箱地址会自动加粗变红。 我们希望这EXCEL能在那人从邮箱打开时，自动识别此人，然后从F列自动记录此人的用户名。（以免追溯不到具体的操作人） 这邮件是同时发送的，不是先后发送。

[蜗牛学编程]

引用 15 楼 milaoshu1020 的回复:

如果是这样,方便把以前的那个Excel文件发出来看看吗? 我想看他是怎么实现识别当前用户邮件地址,还有如何同步的. 另外你说的用户名是哪个?Excel设置中的还是windows账号?或者别的?

没办法发送，公司文件都禁止发到外部去，一发就会报警被公司知道了。而那原文件也加密锁住，看不到代码。不然我应该可以慢慢去解读它。 用户名是指邮箱名称，譬如张三的邮箱是[e-mail]，最后显示出来的就是：zhangsan3 我们公司都是用的outlook，应该是2016版的吧。还真没注意看过。

[milaoshu1020]

这个是没有考虑同步问题的代码:

Option Explicit

Function GetMyEmailRowNum() As Integer
    Dim objOutlook As Object
    Set objOutlook = CreateObject("outlook.application")
    
    Dim objNS As Object
    Set objNS = objOutlook.getnamespace("mapi")
    
    Dim strEmail As String
    strEmail = objNS.CurrentUser.Address
    
    Dim i As Integer
    For i = 8 To 14 Step 3
        If Cells(i, 3) = strEmail Then
            GetMyEmailRowNum = i
            Exit Function
        End If
    Next
    GetMyEmailRowNum = 0
End Function

Sub approve_Click()
    Dim intRow As Integer
    intRow = GetMyEmailRowNum()
    
    If intRow = 0 Then
        MsgBox "审批失败: 您的邮件地址不在列表中!", vbExclamation
    Else
        Cells(intRow, 5) = "Approve"
    End If
End Sub

Sub reject_Click()
    Dim intRow As Integer
    intRow = GetMyEmailRowNum()
    
    If intRow = 0 Then
        MsgBox "审批失败: 您的邮件地址不在列表中!", vbExclamation
    Else
        Cells(intRow, 5) = "Reject"
    End If
End Sub

运行示例:

下载地址:
链接：https://pan.baidu.com/s/1HLrSKvhxHr4UkcQ37CibCQ
提取码：wsij

[milaoshu1020]

如果需要同步的话,可以考虑使用asp或者局域网文件共享;

[milaoshu1020]

如果是这样,方便把以前的那个Excel文件发出来看看吗?
我想看他是怎么实现识别当前用户邮件地址,还有如何同步的.

另外你说的用户名是哪个?Excel设置中的还是windows账号?或者别的?

[milaoshu1020]

你们是不是全体人员都用outlook收发邮件?
你们的outlook是什么版本的?