👉 Análisis de ayuda internacional con Python: dataset OECD + notebook listo para usar

Imagen
🌍 Análisis de ayuda internacional con Python: dataset OECD + notebook listo para usar En el mundo de las relaciones internacionales, uno de los temas más relevantes —y a la vez menos comprendidos— es cómo se distribuyen los recursos destinados al desarrollo global. ¿Quién financia estos proyectos? ¿A qué países se dirigen los recursos? ¿Qué regiones reciben mayor apoyo? Para responder estas preguntas, realicé un análisis utilizando datos abiertos de la Organisation for Economic Co-operation and Development (OECD), específicamente del dataset Country Programmable Aid (CPA) , parte de los registros de Official Development Assistance (ODA) . 📊 El reto de trabajar con datos reales Uno de los principales aprendizajes de este análisis es que los datos del mundo real no vienen listos para usarse. Columnas desalineadas Registros inconsistentes Valores mezclados en campos clave Formatos que requieren limpieza Por esta razón, una parte fundamental del proyecto fue el proceso de lim...
Publicar un comentario

Macro de Excel para aprobaciones y otras opciones de aprobaciones digitales

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

Dejanos tus dudas y comentarios

🚀 Mantener este blog funcionando requiere tiempo y café. ¡Puedes contribuir con uno aquí!

Entradas más populares de este blog

Guía Práctica: Ejemplo Completo de ASPX para Desarrolladores Web

Imagen
Bienvenidos a programacionparatodos.com Esta semana vamos a conocer otro lenguaje de programación que es ASP ( Active Server Pages  )  que es de la familia de Microsoft es plataforma Cliente/Servidor y que permite crear páginas WEB dinámicas, utiliza un servicio conocido como IIS o  (Internet Information Services) fue creado en 1996. Cuando ven paginas WEB que terminan en .aspx es que están desarrolladas con este lenguaje. Páginas  que por ejemplo utilizan ASP https://www.cfe.mx/Pages/Index.aspx https://www.interfactura.com/Index.aspx https://www.canadainternational.gc.ca/mexico-mexique/index.aspx?lang=spa Igual hay mucho trabajo para este software por ejemplo les dejó las siguientes vacantes  Desarrollador .NET .NET Developer NET LEAD Para seguir con el formato del blog, les quiero compartir un programa de ejemplo, pero he de decirles que es la primera vez que programo en ASP , ya que no lo había hecho antes, me tomo...
Leer más

API de banxico para obtener tipo de cambio utilizando Javascript

Imagen
En esta entrada vamos a ver un código de Javascript para obtener el tipo de cambio del Banco de México (Banxico) mediante  API, puedes usar el siguiente código JavaScript. Este ejemplo utiliza `fetch` para realizar la solicitud a la API. Asegúrate de tener una API Key de Banxico. Banxico token Para poder ejecutarlo necesitamos obtener primero nuestro token en  https://www.banxico.org.mx/SieAPIRest/service/v1/token Con ese token puedes hacer hasta 40,000 consultas gratis por día. Cómo llamar api de banxico y javascript Después necesitamos identificar la serie del dato que queremos identificar , en este ejemplo vamos a utilizar la serie  SF43718 el cual obtenemos de la liga   https://www.banxico.org.mx/SieAPIRest/service/v1/doc/catalogoSeries# <html> <head>     <title>Tipo de Cambio Banxico</title>     <style>         body {             font-family: Arial, sans-serif; ...
Leer más

Macro en Word para automatizar documentos: genera diplomas en segundos (con código VBA)

Imagen
Macro en Word para automatizar documentos y generar diplomas automáticamente (VBA paso a paso) ¿Sigues creando documentos uno por uno en Word? Si generas diplomas, constancias, contratos o reportes manualmente, este proceso puede quitarte horas cada semana. En esta guía aprenderás cómo automatizar documentos en Word usando una macro VBA , permitiéndote generar múltiples archivos en segundos y reducir errores humanos. Este tutorial es ideal para administrativos, analistas, docentes y cualquier profesional que quiera ahorrar tiempo y mejorar su productividad. ¿Qué problemas resuelve esta macro? Evita crear documentos manualmente Reduce errores al copiar nombres Ahorra horas de trabajo administrativo Permite generar múltiples diplomas en segundos Mejora tu eficiencia profesional ¿Sabías que no solo en Excel puedes crear macros? También puedes automatizar tareas en Word, Outlook, PowerPoint y Access gracias a Visual Basic para Aplicaciones (VBA). Cómo hab...
Leer más