📊 Automatiza tu trabajo: Convierte tablas de Word a Excel con una macro

Imagen
 Si trabajas en una oficina, seguro te enfrentas a tareas repetitivas que consumen mucho tiempo, como copiar datos de una tabla en Word a una hoja de Excel.   Afortunadamente, existe una forma de automatizar este proceso mediante macros en Word, lo que te permitirá ahorrar tiempo y esfuerzo, y enfocarte en tareas más importantes. ¿Qué es una macro? Una macro es una secuencia de instrucciones que te permite automatizar tareas repetitivas en aplicaciones como Word y Excel. Utilizando el lenguaje VBA (Visual Basic for Applications), puedes escribir códigos que realicen tareas como copiar tablas de un documento de Word y pegarlas en una hoja de Excel con solo hacer clic en un botón. ¿Por qué debería usar una macro para convertir tablas de Word a Excel? Ahorra tiempo : Si trabajas con grandes cantidades de datos, una macro puede copiar todo de una tabla a Excel de forma rápida y precisa. Minimiza errores : El proceso manual de copiar y pegar puede dar lugar a errores humanos, ...
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

Macro de Excel para abrir archivo csv

Imagen
Hay veces que quieres abrir un archivo de Excel pero está separado por comas, punto y coma o por un pipe. Hay formas de hacerlos desde Excel. Les quiero compartir algunas opciones de como hacerlo y espero que les sean de utilidad. 1.Es abrir el archivo en Excel y utilizar la función de separar por columnas y seleccionar el delimitador, por ejemplo ";" 2. Es colocar "sep=;" en el primer renglón del archivo que quieres abrir y guardar en formato CSV y abrirlo en Excel y te lo abrirá separado en columnas. 3. Otra forma es con una macro, esté en mi gusto es la que más me funciona porque si hay alguna coma en la descripción o en alguna columna, si lo abres desde Excel te va a desacomodar las columnas.  Este botón te abrirá un pantalla para abrir el archivo que quieres separar y te lo abrirá en una hoja de excel ya separado. El código de la macro es el siguiente  Private Sub CommandButton1_Click() Dim sht As Worksheet Dim fnd As Variant Dim rplc ...
Leer más

📊 Automatiza tu trabajo: Convierte tablas de Word a Excel con una macro

Imagen
 Si trabajas en una oficina, seguro te enfrentas a tareas repetitivas que consumen mucho tiempo, como copiar datos de una tabla en Word a una hoja de Excel.   Afortunadamente, existe una forma de automatizar este proceso mediante macros en Word, lo que te permitirá ahorrar tiempo y esfuerzo, y enfocarte en tareas más importantes. ¿Qué es una macro? Una macro es una secuencia de instrucciones que te permite automatizar tareas repetitivas en aplicaciones como Word y Excel. Utilizando el lenguaje VBA (Visual Basic for Applications), puedes escribir códigos que realicen tareas como copiar tablas de un documento de Word y pegarlas en una hoja de Excel con solo hacer clic en un botón. ¿Por qué debería usar una macro para convertir tablas de Word a Excel? Ahorra tiempo : Si trabajas con grandes cantidades de datos, una macro puede copiar todo de una tabla a Excel de forma rápida y precisa. Minimiza errores : El proceso manual de copiar y pegar puede dar lugar a errores humanos, ...
Leer más