Hola, en estos días que estamos viviendo cambios en nuestra forma de trabajar, ya se trabajando desde casa, entrando a la oficina de forma escalonada, utilizando tecnología que no habías utilizado antes, conferencias, correos, grabar vídeos para clases, etc.
Algunas opciones para firmar documentos de manera electrónica
- Con un flujo en Sharepoint
- Un formato de Infopath de Microsoft
- Creando llaves certificadas
- Abode Reader
- Crear un WorkFlow o flujo de aprobación en sus sistemas de ERP
En Adobe Reader por ejemplo pueden exportar cualquier archivo de Microsoft a PDF y asignarle la firma, seleccionando en la barra el icono de Firma, puedes colocar una imagen, tus iniciales, un texto
Viendo esto recordé una macro con la que trabaje hace algún tiempo para poder adicionar firmas electrónicas y envíar el archivo por correo a un siguiente aprobador y validando el aprobador, esto puede funcionar si hay personas fuera de la oficina y necesitas que se firmen documentos para autorizar procesos.
El formato en Excel es como la siguiente imagen
La macro tiene el siguiente código
Public correo1, correo2, correo3, correo4, correo5 As String
Private Sub Workbook_open()
correo1 = "programacionparatodos@prog.com" 'Nive11
End Sub
Private Sub CommandButton2_Click() 'boton de enviar_formato
Dim fila As Integer
Dim nombre As String
CommandButton1.Enabled = False 'llenado
CommandButton3.Enabled = True 'approve
CommandButton4.Enabled = True 'reject
correo1 = "programacionparatodos@prog.com" 'Nive11
correo2 = "zelideth27@gmail.com" 'Nivel2
'copy format in one file
If Range("C20").Interior.Color = RGB(255, 255, 255) Then Do 'primer envio
fila = 0
'nombre del archivo
nombre = "Aprobar_Venta" + Sheet5.Range("B4") + Trim(Str(Year(Date))) + Trim(Str(Month(Date))) + Trim(Str(Day(Date)))
mio = ActiveWorkbook.Name
Workbooks.Add
otro = ActiveWorkbook.Name
Workbooks(mio).Activate
Sheets(4).Copy after:=Workbooks(otro).ActiveSheet
Application.DisplayAlerts = False
Workbooks(otro).Sheets(1).Delete
ActiveWorkbook.SaveAs filename:=ThisWorkbook.Path & "\" & Replace(nombre, "/", ""), FileFormat:=xlOpenXMLWorkbookMacroEnabled
'xlOpenXMLWorkbook
Application.DisplayAlerts = False
ActiveWorkbook.Close False
nombre = ThisWorkbook.Path & "\" & Replace(nombre, "/", "") & ".xlsm"
Call Send_File(nombre)
CommandButton3.Enabled = False 'approve
CommandButton4.Enabled = False 'reject
CommandButton1.Enabled = True
End If
End Sub
Private Sub Send_File(filename As String)
Dim stFileName As String
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim Body As Object
Dim stAttachment As String
Dim stSubject As String
Dim vaMsg As String
Dim nombre As String
Dim strTo As String
'send mail to supervidor
'If Abs(Cells(23, 5)) >= 1 And Abs(Cells(23, 5)) <= 99 And Range("C37").Interior.Color = RGB(255, 255, 255) Then
If Range("C37").Interior.Color = RGB(255, 255, 255) Then
strTo = correo1
End If
If Abs(Cells(23, 5)) >= 100 And Abs(Cells(23, 5)) <= 499 And Range("C37").Interior.Color = RGB(51, 204, 51) Then
strTo = correo2
End If
If Abs(Cells(23, 5)) >= 500 And Abs(Cells(23, 5)) <= 999 And Range("C38").Interior.Color = RGB(51, 204, 51) Then
strTo = correo3
End If
If Abs(Cells(23, 5)) >= 1000 And Abs(Cells(23, 5)) <= 4999 And Range("C39").Interior.Color = RGB(51, 204, 51) Then
strTo = correo4
End If
If Abs(Cells(23, 5)) >= 5000 And Abs(Cells(23, 5)) <= 14999 And Range("C40").Interior.Color = RGB(51, 204, 51) Then
strTo = correo5
End If
If Abs(Cells(23, 5)) >= 15000 Then
strTo = correo6
End If
'Create the list of recipients.
stSubject = "Authorization_cycle_acount" + Sheet5.Range("B4") + Trim(Str(Year(Date))) + Trim(Str(Month(Date))) + Trim(Str(Day(Date)))
vaMsg = "Please review and Approve o Reject the inventory asjusment"
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail
Set noDocument = noDatabase.CreateDocument
'Example to create an attachment (optional)
Set Body = noDocument.CreateRichTextItem("Body")
Call Body.APPENDTEXT(vaMsg)
Call Body.ADDNEWLINE(2)
Call Body.EMBEDOBJECT(1454, "", filename, "Attachment")
' MsgBox filename
noDocument.SAVEMESSAGEONSEND = True
'Example to set return receipt (optional)
noDocument.DeliveryReport = "B"
'Example to set high priority (optional)
' MailDoc.DeliveryPriority = "H"
Call noDocument.ReplaceItemValue("SendTo", strTo)
Call noDocument.ReplaceItemValue("Subject", stSubject)
Call noDocument.ReplaceItemValue("PostedDate", Now())
Call noDocument.Send(False)
'Add values to the created e-mail main properties.
' With noDocument
' .Form = "Memo"
' .SendTo = vaRecipients
' .Subject = stSubject
' .SaveMessageOnSend = True
' .PostedDate = Now()
' .Send 0, vaRecipients
' End With
'Delete the temporarily workbook.
'Kill stAttachment
'Release objects from memory.
Set Body = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
MsgBox "The e-mail has successfully been created and distributed" + strTo, vbInformation
End Sub
Private Sub CommandButton3_Click()
'Aprove
If Abs(Cells(23, 5)) >= 1 And Abs(Cells(23, 5)) <= 99 Then
Call approve_1("C37")
End If
If Abs(Cells(23, 5)) >= 100 And Abs(Cells(23, 5)) <= 499 Then
Call approve_1("C37")
Call approve_2("C38", "C37")
End If
If Abs(Cells(23, 5)) >= 500 And Abs(Cells(23, 5)) <= 999 Then
Call approve_1("C37")
Call approve_2("C38", "C37")
Call approve_3("C39", "C38")
End If
If Abs(Cells(23, 5)) >= 1000 And Abs(Cells(23, 5)) <= 4999 Then
Call approve_1("C37")
Call approve_2("C38", "C37")
Call approve_3("C39", "C38")
Call approve_4("C40", "C39")
End If
If Abs(Cells(23, 5)) >= 5000 And Abs(Cells(23, 5)) <= 14999 Then
Call approve_5("C41")
End If
If Abs(Cells(23, 5)) >= 15000 Then
Call approve_6("C42")
End If
End Sub
Private Sub CommandButton4_Click()
'Reject
If Abs(Cells(23, 5)) >= 1 And Abs(Cells(23, 5)) <= 99 Then
Call reject_1("C37")
End If
If Abs(Cells(23, 5)) >= 100 And Abs(Cells(23, 5)) <= 499 Then
Call reject_1("C37")
Call reject_2("C38", "C37")
End If
If Abs(Cells(23, 5)) >= 500 And Abs(Cells(23, 5)) <= 999 Then
Call reject_1("C37")
Call reject_2("C38", "C37")
Call reject_3("C39", "C38")
End If
If Abs(Cells(23, 5)) >= 1000 And Abs(Cells(23, 5)) <= 4999 Then
Call reject_1("C37")
Call reject_2("C38", "C37")
Call reject_3("C39", "C38")
Call reject_4("C40", "C39")
End If
If Abs(Cells(23, 5)) >= 5000 And Abs(Cells(23, 5)) <= 14999 Then
Call reject_5("C41")
End If
If Abs(Cells(23, 5)) >= 15000 Then
Call reject_6("C42")
End If
End Sub
Private Sub approve_1(Celda As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailServer = noSession.GetEnvironmentString("MailServer", True)
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
correo1 = "rtes@test.com" 'jefe
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo1, "@")
vc_mail2 = Left(correo1, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
'Approve first level
If Not (Dir("C:\Users\Ana Zamora\Documents\sig1.jpg") > "") Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "APPROVE"
Range(Celda).Interior.Color = RGB(51, 204, 51)
Else
MsgBox ("This signature has already been applied!")
End If
Else
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Select
Dim Sh As Shape
With Worksheets("Formato 2018")
For Each Sh In .Shapes
If Not Application.Intersect(Sh.TopLeftCell, .Range(Celda)) Is Nothing Then
MsgBox ("This signature has already been applied!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Next Sh
End With
ActiveSheet.Pictures.Insert("C:\Users\Ana Zamora\Documents\sig1.jpg").Select
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Select
Range(Celda).Interior.Color = RGB(51, 204, 51)
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = ActiveCell.RowHeight
.ShapeRange.Width = ActiveCell.Width
.Placement = xlMoveAndSize
End With
End If
Else
MsgBox ("Usuario not valid to Approve")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Set noDatabase = Nothing
Set noSession = Nothing
End Sub
Private Sub approve_2(Celda As String, Celda2 As String)
'Approve second level
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
correo2 = "ana.zamora@test.com"
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo2, "@")
vc_mail2 = Left(correo2, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "APPROVE"
Range(Celda).Interior.Color = RGB(51, 204, 51)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to Approve")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub approve_3(Celda As String, Celda2 As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
correo3 = "mail3@test.com"
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo3, "@")
vc_mail2 = Left(correo3, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "APPROVE"
Range(Celda).Interior.Color = RGB(51, 204, 51)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to Approve")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub approve_4(Celda As String, Celda2 As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
correo4 = "mail4@test.com"
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo4, "@")
vc_mail2 = Left(correo4, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "APPROVE"
Range(Celda).Interior.Color = RGB(51, 204, 51)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to Approve")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub approve_5(Celda As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
correo5 = "mail5@test.com"
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo5, "@")
vc_mail2 = Left(correo5, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "APPROVE"
Range(Celda).Interior.Color = RGB(51, 204, 51)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to Approve")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub approve_6(Celda As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo5, "@")
vc_mail2 = Left(correo5, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "APPROVE"
Range(Celda).Interior.Color = RGB(51, 204, 51)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to Approve")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub reject_1(Celda As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailServer = noSession.GetEnvironmentString("MailServer", True)
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
correo1 = "correo1@test.com" 'supervisor
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo1, "@")
vc_mail2 = Left(correo1, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
'reject first level
If Not (Dir("C:\Users\Ana Zamora\Documents\sig1.jpg") > "") Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "Reject"
Range(Celda).Interior.Color = RGB(255, 0, 0)
Else
MsgBox ("This signature has already been applied!")
End If
Else
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Select
Dim Sh As Shape
With Worksheets("Formato 2018")
For Each Sh In .Shapes
If Not Application.Intersect(Sh.TopLeftCell, .Range(Celda)) Is Nothing Then
MsgBox ("This signature has already been applied!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Next Sh
End With
ActiveSheet.Pictures.Insert("C:\Users\Ana Zamora\Documents\sig1.jpg").Select
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Select
Range(Celda).Interior.Color = RGB(255, 0, 0)
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = ActiveCell.RowHeight
.ShapeRange.Width = ActiveCell.Width
.Placement = xlMoveAndSize
End With
End If
Else
MsgBox ("Usuario not valid to reject")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Set noDatabase = Nothing
Set noSession = Nothing
End Sub
Private Sub reject_2(Celda As String, Celda2 As String)
'reject second level
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
correo2 = "ana.zamora@test.com"
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo2, "@")
vc_mail2 = Left(correo2, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "Reject"
Range(Celda).Interior.Color = RGB(255, 0, 0)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to reject")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub reject_3(Celda As String, Celda2 As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
correo3 = "correo2@test.com"
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo3, "@")
vc_mail2 = Left(correo3, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "reject"
Range(Celda).Interior.Color = RGB(255, 0, 0)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to reject")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub reject_4(Celda As String, Celda2 As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
correo4 = "mail4@ests.com"
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo4, "@")
vc_mail2 = Left(correo4, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "Reject"
Range(Celda).Interior.Color = RGB(255, 0, 0)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to reject")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub reject_5(Celda As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
correo5 = "correo5@test.com"
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo5, "@")
vc_mail2 = Left(correo5, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "Reject"
Range(Celda).Interior.Color = RGB(255, 0, 0)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to reject")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub reject_6(Celda As String)
Dim noSession As Object
Dim noDatabase As Object
Dim MailServer As String 'this is the users mail server
Dim MailDB As Object 'this is the users mail database
Dim MailDBName As String
Dim pos_mail As Integer
Dim pos_mail2 As Integer
Dim vc_mail As String
Dim vc_mail2 As String
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
MailDBName = noSession.GetEnvironmentString("KeyFileName_Owner", True)
'MsgBox MailDBName
pos_mail = InStr(MailDBName, "/")
vc_mail = Mid(MailDBName, 4, pos_mail - 4)
pos_mail2 = InStr(correo5, "@")
vc_mail2 = Left(correo5, pos_mail2 - 1)
vc_mail2 = Replace(vc_mail2, ".", " ")
If LCase(vc_mail) = LCase(vc_mail2) Then
If Range(Celda).Value = "" Then
ActiveSheet.Unprotect Password:="testpass"
Range(Celda).Value = "Reject"
Range(Celda).Interior.Color = RGB(255, 0, 0)
Else
MsgBox ("This signature has already been applied!")
End If
If Range(Celda2).Interior.Color <> RGB(51, 204, 51) Then
MsgBox ("Missing previous authorization!")
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
Exit Sub
End If
Else
MsgBox ("Usuario not valid to reject")
End If
CommandButton4.Enabled = False
CommandButton1.Enabled = False
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
Private Sub CommandButton5_Click()
ActiveSheet.Unprotect Password:="testpass"
Sheet5.Range("A8:C22") = ""
Range("C37").Interior.Color = RGB(255, 255, 255)
Range("C38").Interior.Color = RGB(255, 255, 255)
Range("C39").Interior.Color = RGB(255, 255, 255)
Range("C40").Interior.Color = RGB(255, 255, 255)
Range("C41").Interior.Color = RGB(255, 255, 255)
Range("C42").Interior.Color = RGB(255, 255, 255)
Range("C43").Interior.Color = RGB(255, 255, 255)
Range("E37").Interior.Color = RGB(255, 255, 255)
Range("E38").Interior.Color = RGB(255, 255, 255)
Range("E39").Interior.Color = RGB(255, 255, 255)
Range("E40").Interior.Color = RGB(255, 255, 255)
Range("E41").Interior.Color = RGB(255, 255, 255)
Range("E42").Interior.Color = RGB(255, 255, 255)
Range("E43").Interior.Color = RGB(255, 255, 255)
Sheet5.Range("C37:e43") = ""
ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
End Sub
No olvides compartirnos y seguirnos en este blog o en Facebook.
Comentarios
Publicar un comentario