Buscar entre fecha y fecha





La consulta de datos entre fecha y fecha es un tema muy consultado, aquí se agrega un ejemplo que crea un informe entre fechas seleccionadas, se agrega como aditamento tres bucles uno dentro de otro con luego de cumplir ciertos criterios suma las ventas correspondientes a cada cliente, en el link del final se podrá descargar el archivo de ejemplo, quizás también te interese ver una variante que consulta el saldo entre fecha y fecha .Te recomiendo que leas el post Funciones de fecha y hora y quizas te interese saber sobre formatos de fecha y hora.





Código que se inserta en botón de formulario 

Private Sub ComboBox1_AfterUpdate()
TextBox1 = CDate(Date - 30)
TextBox2 = CDate(Date)
End Sub

Private Sub CommandButton1_Click()
'Controla los datos ingresados en los cuadro de textbox1 sean fechas
Application.ScreenUpdating = False
'Controlo posibles errores
On Error Resume Next
If Not IsDate(TextBox1.Text) Then
MsgBox "fecha inválida"
TextBox1.SetFocus
Exit Sub
End If
'Valida fecha
Dim ubica1, ubica2 As String
Dim dia, mes As Integer
Dim año, fecha As Integer
'guardamos en variables el caracter encontrado en la posición 3 y 6
ubica1 = Mid(TextBox1.Text, 3, 1)
ubica2 = Mid(TextBox1.Text, 6, 1)
'comparamos si se trata de '/'
If ubica1 <> "/" Or ubica2 <> "/" Then
MsgBox ("Debes ingresar datos con este formato: dd/mm/aa")
TextBox1.SetFocus
Exit Sub
End If
dia = Mid(TextBox1.Value, 1, 2)
mes = Mid(TextBox1.Value, 4, 2)
año = Mid(TextBox1.Value, 7, 4)
fecha = Len(TextBox1)

'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia > 31 Or mes > 12 Or año < 1900 Or fecha > 10 Then
MsgBox "Fecha incorrecta"
TextBox1.SetFocus
Exit Sub
End If

'Controla los datos ingresados en los cuadro de textbox2 sean fechas
If Not IsDate(TextBox2.Text) Then
MsgBox "fecha inválida"
TextBox2.SetFocus
Exit Sub
End If
'Valida fecha
Dim ubicatext1, ubicatext2 As String
Dim dia1, mes1 As Integer
Dim año1, fecha1 As Integer
'guardamos en variables el caracter encontrado en la posición 3 y 6
ubicatext2 = Mid(TextBox2.Text, 3, 1)
ubicatext2 = Mid(TextBox2.Text, 6, 1)
'comparamos si se trata de '/'
If ubicatext2 <> "/" Or ubicatext2 <> "/" Then
MsgBox ("Debes ingresar datos con este formato: dd/mm/aa")
TextBox2.SetFocus
Exit Sub
End If
dia1 = Mid(TextBox2.Value, 1, 2)
mes1 = Mid(TextBox2.Value, 4, 2)
año1 = Mid(TextBox2.Value, 7, 4)
fecha1 = Len(TextBox2)

'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia1 > 31 Or mes1 > 12 Or año1 < 1900 Or fecha1 > 10 Then
MsgBox "Fecha incorrecta"
TextBox2.SetFocus
Exit Sub
End If
'Controla que la fecha final no sea menor a la inicial
Dim fechainicio As Date
Dim fechafinal As Date
fechainicio = TextBox1.Value
fechafinal = TextBox2.Value
If fechainicio > fechafinal Then
MsgBox "Fecha inválida"
TextBox2.SetFocus
Exit Sub
End If


'Muestra progressbar
Unload Me
ProgressForm.Show False
Dim R As Integer
Dim MT As Double
For R = 1 To 10
 MT = Timer
 ProgressForm.ProgressBar1.Max = 10
 Do
  Loop While Timer - MT < 0.05
   ProgressForm.ProgressBar1.Value = R
   ProgressForm.Label1.Caption = "Consultando datos......."
  
 DoEvents
Next R
Unload ProgressForm



' Busca los datos entre las fechas ingresadas
'quito protección de hoja si es que la tiene
'Sheets("listado op").Unprotect Password:="miclave"
'Dimensiono variables
Dim colinfo As Integer
Dim filainfo As Integer
Dim filavtas As Integer
Dim filavtas1 As Integer
Dim filanom As Integer
Dim filanom1 As Integer
Dim Acum, Tacum As Currency
Dim dato1 As Date
MASTERCARD PAYONEER

Dim dato2 As Date
Dim condi1  As Date
Dim condi2 As Date
Dim dato3 As String
Dim dato4 As String
Dim dato5 As String
Dim dato6 As String
colinfo = 2
filainfo = 3
filavtas = 2
filanom = 2
filanom1 = 2
filavtas1 = 2
cond1 = TextBox1.Value
cond2 = TextBox2.Value
Acum = 0
Tacum = 0
'Realiza bucle mientras no haya columnas vacias
 While Sheets("info").Cells(2, colinfo) <> Empty
 


  'Realiza un nuevo bucle mietras no haya filas vacias recorriendo la fila de vtas
    While Sheets("info").Cells(filainfo, 1) <> Empty
           
             While Sheets("vtas").Cells(filanom, 1) <> Empty
                    dato1 = Sheets("vtas").Cells(filavtas, 1).Value
                    dato2 = Sheets("vtas").Cells(filavtas, 1).Value
                    dato3 = Sheets("info").Cells(2, colinfo).Value
                    dato4 = Sheets("vtas").Cells(filanom, 6).Value
                    dato5 = Sheets("info").Cells(filainfo, 1).Value
                    dato6 = Sheets("vtas").Cells(filavtas, 7).Value
               
                    If dato1 >= cond1 And dato2 <= cond2 And dato3 = dato4 And dato5 = dato6 Then
                   
                            While Sheets("vtas").Cells(filavtas1, 1) <> Empty
                                   dato4 = Sheets("vtas").Cells(filanom1, 6).Value
                                   dato5 = Sheets("info").Cells(filainfo, 1).Value
                                   dato6 = Sheets("vtas").Cells(filavtas1, 7).Value
                                 
                                  If dato1 >= cond1 And dato2 <= cond2 And dato3 = dato4 And dato5 = dato6 Then
                                       Acum = Sheets("vtas").Cells(filavtas1, 9)
                                       Tacum = Tacum + Acum
                                       Sheets("info").Cells(filainfo, colinfo) = Tacum
                                      
                                  End If
                                 
                               filavtas1 = filavtas1 + 1
                               filanom1 = filanom1 + 1
                             Wend
                           
                    
                     End If
                Acum = 0
                Tacum = 0
                filavtas1 = 2
                filanom1 = 2
                filanom = filanom + 1
                filavtas = filavtas + 1
             Wend
     
      filavtas1 = 2
      filanom1 = 2
      filanom = 2
      filavtas = 2
      filainfo = filainfo + 1
     
      Wend
 filavtas1 = 2
 filanom1 = 2
 filanom = 2
 filavtas = 2
 filainfo = 3
 colinfo = colinfo + 1
 Wend

 'Cierro el formulario
 Unload Me
'Sheets("listado OP").Protect Password:="miclave"
'Devuelvo movimientos a la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub Label3_Click()
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
TextBox2 = CDate(Date)
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub



Click para bajar archivo



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.



If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.




Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Enviar Mail con Excel





Seguramente alguna vez te preguntaste como hacer que salga un cartel de AVISO o enviara mails con Excel o si es posible que se envíe un mail directamente desde Excel; este procedimiento de VBA  o Macro para envíar mails con Excel da respuesta a este interrogante, a mi entender, es sumamente útil, lo que hace básicamente es enviar mail desde excel, en el ejemplo que se agrega en este post se utiliza una cuenta de gmail, pero funciona con yahoo, hotmail, etc. se debe cambiar el puerto de salida en función del puerto smtp que use cada uno de los web mails. En este ejemplo se muestra con enviar mail a varios destinatarios.

Está programado para recorrer las filas de un rango y enviar una serie de mail de una lista, pero se puede modificar para enviar un soló mail si se quiere, es cuestión de adaptarlo a lo que se requiera. Haz click en el link del final para descargar el ejemplo.

Es preciso para que esta macro que envía mails funcione, que en la función que envía los mails cambies el nombre por tu cuenta de gmail para que funcione, si pones otro web mail debes cambiar unas líneas más abajo el puerto del servidor smtp, en Excel cambia las direcciones que se pusieron de muestra y agrega direcciones válidas.

Es preciso aclarar que en este ejemplo se envía mail con correos basados en la web como Gmail, Hotmail o  Yahoo, lo cual lo hace  diferente a otros ejemplos publicados sobre como enviar mails con Excel, el motivo del  post  radicó en la cantidad de usuarios que hacen usos de Gmail, Hotmail  y Yahoo.



Función se agrega en un módulo

Function SendMail_Gmail() As Boolean
'Dimensiono variables
Dim Email As CDO.Message
Dim Autentificion As Boolean
'Creo el objeto email
Set Email = New CDO.Message
'Ponemos datos del servidor a usar
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
'Indicamos el número de puerto smtp
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
'Decimos si requiere o no autentificación 1 requiere, 0 no requiere
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
'Segundos de espera
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
'Definición de verdadero para la autentificación
Autentificacion = True
'Configuramos el ingreso al mail
If Autentificacion Then
    'nombre de usuario
    Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "micorreo1111xxx444xxxxx444xxx44x@gmail.com"
    'password
    Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "111111"
    'si el servidor utiliza SSL (secure socket layer). en gmail: True
    Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End If
' Una vez configurado nuestro servidor de correo tomados datos de excel para enviar el mail
    'Correo del destinatario
    Email.To = Trim(["a" & fila].Value)
    'Dirección del remitente
    Email.From = Trim(["b"& fila].Value)
   ' Asunto
    Email.Subject = Trim(["c"& fila].Value)
   ' Mensaje
    Email.TextBody = Trim(["d" & fila].Value)
   'Path del archivo attach
   If [a2].Value <> vbNullString Then
      Email.AddAttachment (Trim(["e"& fila].Value))
   End If
   'Actualizamos datos antes del envio
    Email.Configuration.Fields.Update
   'Controlo errores
   On Error Resume Next
   'enviamos propiamente el mail
    Email.Send
    'Si no hay errores la funcion es verdadero
    If Err.Number = 0 Then
       SendMail_Gmail = True
    Else
     'Sale msgbox con descripción del error
       MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
   End If
   'Borro los objetos
    If Not Email Is Nothing Then
       Set Email = Nothing
    End If
    'Controlo errores
    On Error GoTo 0
End Function



Código que se agrega en un módulo
Public fila
Sub SendMail()
Dim fila As String
Dim Exito As Boolean
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
fila = 2
'Bucle en caso de haber listado de direcciones de correo
While Sheets("dire").Cells(fila, 1) <> Empty
    'Si queremos enviar un solo mail va esta parte solamente
    'Dim Exito As Boolean
    'llamo a la funcion:
    Exito = SendMail_Gmail()
    'Si es verdadero, es decir el mail se envio
        If Exito = True Then
        MsgBox "El mail se envió con éxito", vbInformation, "Informe"
        End If
fila = fila + 1
Wend
Application.ScreenUpdating = True
End Sub

Te recomiendo que leas un excelente libro sobre Excel el que te ayudará manejar las planillas de cálculo, debes hacer click acá.




Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.



If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Copia hyperlink




Este es un sencillo ejemplo, pero no por ello muy útil para copiar hyperlink en Excel o hipervinculo mendiante vba; el procedimiento realiza un bucle en la columna 1 mientras encuentre datos y copia el hyperlink en la columna 2, en el link del final encontrarás un ejemplo de macro que copia hipervinculo o hyperlink, bájalo y modifica a tu gusto.



Antes de continuar recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

Suscribe a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo formulario que crea un listado de todas las hojas para poder luego seleccionarlasbuscar en listbox mientras escribes en textboxordenar hojas libro excel por su nombreconectar Excel con Access y muchos ejemplos más.









Sub copia()

Dim fila As Integer
fila = 2
Sheets("hoja1").Range("A2").Select
'bucle que se realiza mientras la celda no sea empty
 While Sheets("hoja1").Cells(fila, 1) <> Empty
 'copia   hyperlink de una columna a otra
 Sheets("hoja1").Cells(fila, 1).Hyperlinks.Add Anchor:=Sheets("hoja1").Cells(fila, 2), Address:=Sheets("hoja1").Cells(fila, 1).Hyperlinks(1).Address
 
 fila = fila + 1
 Wend
End Sub




Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.




If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Macro Inserta Imágenes en Excel





Este procedimiento de VBA o macro de Excel inserta imágenes en Excel, básicamente lo que hace es un bucle recorriendo todas la filas que tengan datos de cierta columna e insertar la imagen cuyo path se encuentra en las filas donde realiza el bucle, modificando alto, ancho, ubicación de la imagen superior e inferior, es decir controla que se ubiquen una abajo de otra y no se superpongan.

Antes de seguir recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

En el post macro que abre el explorador de Windows e inserta fotos, se presenta una variante, ya que también inserta una foto, pero ésta es seleccionada desde el explorador de archivos; abajo les dejo el ejemplo para descargar el cual pueden adaptar a lo que requiera sus aplicaciones.

El vídeo que sigue muestra una explicación más detallada y gráfica de la macro presentada, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo formulario que crea un listado de todas las hojas para poder luego seleccionarlasbuscar en listbox mientras escribes en textboxordenar hojas libro excel por su nombreconectar Excel con Access y muchos ejemplos más.









Sub InsertaImagen()
'Evito movimientos en la pantalla
Application.ScreenUpdating = False
'Dimensiono variables
Dim fila, superior, num As Integer
Dim path As String
fila = 1
superior = 0
num = 1
'Selecciono la celda donde comienza el bucle
Sheets("fotos").Range("a1").Select
'Controlo errores
On Error Resume Next
'Realiza el bucle mientras la fila x de la columna 1 de hoja fotos no este vacia
While Sheets("fotos").Cells(fila, 1) <> Empty
'Determino la dirección de la foto
    path = Sheets("fotos").Cells(fila, 1)
 
   
'Inserto la imagen y la activo en la hoja de excel
    Set Foto = Sheets("fotos").Pictures.Insert(path)
'Modifico propiedades entre ellas el nombre por si es necesario usarlo, sino
    With Foto
        .Name = num
        .Top = superior
        .Left = 400
        .Width = 150
        .Height = 150
        superior = superior + 150.5
        num = num + 1
    End With
'Elimino objeto
Set Foto = Nothing
fila = fila + 1
   
Wend
'En caso que quisiera eliminar una foto determinada puedo hacerlo así
'Sheets(fotos).Shapes(1).Delete
'Evito movimientos en la pantalla
Application.ScreenUpdating = True
End Sub






Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.




If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Formulario VBA para insertar datos





Este es un ejemplo de formulario que introduce datos en hoja Excel esta programado mediante VBA o Macro de Excel, es algo sencillo, pero te dará una idea de como modificar o complementar el formulario que tu tengas, en el link del final podrás bajar el archivo de ejemplo.



Por favor lee un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.





  

  
Código que se inserta en el formulario

Private Sub CommandButton1_Click()
'Inserta fila
Selection.EntireRow.Insert
'LimpiaLimpia Los Textbox
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
'Envia el cursor al Textbox1 para volver a capturar los datos
TextBox1.SetFocus
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub TextBox1_Change()
Range("a2").Select
ActiveCell.FormulaR1C1 = TextBox1
End Sub
Private Sub TextBox2_Change()
Range("b2").Select
ActiveCell.FormulaR1C1 = TextBox2
End Sub
Private Sub TextBox3_Change()
Range("c2").Select
ActiveCell.FormulaR1C1 = TextBox3
End Sub
Private Sub TextBox4_Change()
Range("d2").Select
ActiveCell.FormulaR1C1 = TextBox4
End Sub
Private Sub TextBox5_Change()
Range("e2").Select
ActiveCell.FormulaR1C1 = TextBox5
End Sub



 Código que se inserta en el un módulo

 Sub CargaFormulario()
'llama al formulario
    Load UserForm1
    UserForm1.Show
  End Sub






Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.



If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Optimista






Hay que ser  optimista ...
 Humor Gráfico
MASTERCARD PAYONEER
  1. Trucos de Excel
  2. Macro que envía mail y emite formulario de aviso
  3. Macro Alerta mediante parpadeo de celda
  4. Glosario de palabras usadas en VBA para Excel
  5. Forma de seleccionar o hacer referencia a celdas, rangos y hojas








Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Busqueda de Datos


Este procedimiento lo que hace es buscar datos, es similar a la función buscarv, pero con código de VBA y mucho más útil, es muy útil cuando se tiene una planilla extensa y se quiere buscar un dato en función de uno o varios criterios, en el ejemplo busca los datos de una hoja que coinciden en otra hoja y trae los datos que necesito a la primer hoja, eso se puede adaptar a las necesidades de cada uno pudiendo manejar una cantidad de datos extensa en segundos; como así también incorporar varios criterios y que busque cualquier dato que se necesite, si tienes alguna duda no dudes en comentar y te responderé a la brevedad. A final se incorpora un link donde puedes bajarte un archivo de Excel con el ejemplo, podrás abrirlo, explorar el código y manipularlo para adaptarlo a tu aplicación, espero te sea de utilidad.

Antes de seguir recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  


Antes de continuar, recomiendo que leas un excelente libro sobre Excel el que te ayudará operar las planillas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

Debes insertar un módulo de VBA, copiar y pegar en módulo el siguiente código, bajate el ejemplo que está en el link del final.

El vídeo que sigue muestra una explicación más detallada y gráfica de la macro presentada, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo formulario que crea un listado de todas las hojas para poder luego seleccionarlasbuscar en listbox mientras escribes en textboxordenar hojas libro excel por su nombreconectar Excel con Access y muchos ejemplos más.










Sub busca()
'Evito movimientos en la pantalla
Application.ScreenUpdating = False
'Dimensiono variables
Dim fila, filaaddress, conta As Integer
fila = 2
filaaddress = 2
conta = 0
On Error Resume Next
'Realiza el bucle mientras la columna 1 de hoja alumno no este vacia
While Sheets("Alumnos").Cells(fila, 1) <> Empty
'Controlo errores

    ' Realizo un nuevo bucle en la hoja adress mientras las filas de la columna 1 de esta hoja no esten vacias
    ' y el cotador sea cero
    While Sheets("Address").Cells(filaaddress, 2) <> Empty And conta = 0
        
      'Si el nombre de la columna uno de la hoja alumno es igual al nombre de la columna uno de la hoja address
       If Sheets("Alumnos").Cells(fila, 1) = Sheets("Address").Cells(filaaddress, 1) Then
 
      'es  decir si encontro el dato, copia la dirección en la hoja alumno y voy a la fila siguiente de la hoja alumnos
      Sheets("Alumnos").Cells(fila, 3) = Sheets("Address").Cells(filaaddress, 2)
      'Si encontro el dato hago que el contador sea 1 para que no busque más
      conta = 1
     
      Else
     'Si no encontro el dato aumento la fila de la hoja address para seguir buscando hasta el final
      filaaddress = filaaddress + 1
      End If
    Wend
   
'Aumento en uno la fila para seguir buscando el dato siguiente de la hoja alumnos
fila = fila + 1
'Vuelvo filaaddress y contador a su valor de origen
filaaddress = 2
conta = 0
Wend
'Vuelvo movimientos de la pantalla a su estado original
Application.ScreenUpdating = True
End Sub


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.



If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Guardar excel automáticamente


Este sencillo código evita dolores de cabeza, al guardar automáticamente cada 1 minuto, en este caso, pero se puede configurar al tiempo que se desee, cambiando time value; cuantas veces nos ha pasado que se tilda la pc o simplemente se corta la luz y perdemos todo el trabajo realizado por no guardar el archivo ya sea porque nos olvidamos o porque nos da pereza guardar el archivo, con este código agregado a tu libro no tendrás que guardar más ya que lo hace automáticamente.

Código que se inserta en thisworkbook

Private Sub Workbook_Open()


Application.OnTime Now + TimeValue("00:01:00"), "grabando"
End Sub


Código que se debe insertar en un módulo de VBA
Sub grabando()
ActiveWorkbook.Save
Application.OnTime Now + TimeValue("00:01:00"), "grabando"

End Sub



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página click para descargar.




If this post was helpful INVITE ME A COFFEE and so help keep up the page.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Parpadeo de Celda


Este código de VBA es bastante interesante, ya que en varias ocasiones se necesita que excel emita un aviso, ya sea para recordar de la fecha de mantenimiento de cierta maquinaria, vencimiento de productos, nivel de stock o simplemente que ayude a recordar algo mediante un aviso, ya sea que aparezca un formulario y nos de el aviso o de otra forma.

En este ejemplo de macro de excel aparece un aviso en celda mediante un parpadeo de color rojo en la celda, está muy relacionado con el post donde excel avisa en forma automática en la celda por aproximación a la fecha de realización de cierto evento, también guarda estrecha relación con el post de formulario de aviso, donde en vez de avisar en la celda, se emite un  formulario de aviso que se cierra en forma automática transcurridos dos segundos.

El procedimiento de VBA, específicamente controla que la celda tenga un cierto valor si el valor es menor a uno dado se ejecuta la macro y empieza a parpadear la celda a modo de aviso; caso contrario no hace nada, tiene la función de alarma, se puede usar en planillas donde se tiene el stock de productos y se necesita que se avise cuando se llega a un stock crítico, el código se debe insertar en una hoja worksheet y en un módulo el resto del procedimiento.

En el link del final podrás descargar el ejemplo y adaptarlo a lo que requieras, no tiene ningún tipo de restricción el código presentado en este ejemplo.


Código que se inserta en la hoja donde se quiere que se realice el evento


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
'controla el cambio en la celda B2

    If Not Intersect(Target, Range("a:a")) Is Nothing Then

'si el valor ingresado es menor a 10 coloca en B4 el texto de Alerta

         If Range("B2") < 10 Then
 
        Range("B4") = "ALERTA: STOCK BAJO"
     
        Else

        Range("B4") = ""
        End If

'ejecuta la rutina de parpadeo

    ChangeColorA1

    End If

End Sub



Código que se ingresa en un módulo


Sub ChangeColorA1()
On Error Resume Next
    If Range("B4").Interior.ColorIndex = 1 Then   'interior colornegro

        Range("B4:D4").Interior.ColorIndex = 3    'interior color rojo

        Range("B4:D4").Font.ColorIndex = 1   'fuente colornegra

    Else

        Range("B4:D4").Interior.ColorIndex = 1   'interior color negro

        Range("B4:D4").Font.ColorIndex = 2        'fuente color rojo

    End If

'controla el contenido de la celda . Si es de Alerta, ejecuta esta rutina de cambio de colores

    If Range("B4").Text = "ALERTA: STOCK BAJO" Then

        Application.OnTime Now + TimeSerial(0, 0, 1), "ChangeColorA1"

    Else

        Range("B4:D4").Interior.ColorIndex = 0  'interior color fijo celeste

        Range("B4:D4").Font.ColorIndex = 3         'fuente color fijo rojo

    End If

End Sub



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Humor Gráfico porcentaje







Un poco de humor gráfico para distenderse de tanta programación.
Humor Gráfico



MASTERCARD PAYONEER

Quizás te interese:
  1. Trucos de Excel
  2. Macro que envía mail y emite formulario de aviso
  3. Macro Alerta mediante parpadeo de celda
  4. Glosario de palabras usadas en VBA para Excel
  5. Forma de seleccionar o hacer referencia a celdas, rangos y hojas






Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Convierte Numero a Letra





Este código de VBA al igual que el post titulado convertir número a letra función  definida por el usuario,  permite convertir números en letras, es muy similar el resultado, ya que varía muy poco en la forma en que escribe los números, se debe usar el que mejor se adapte a lo que queramos hacer, es más podemos tener las dos funciones instaladas en Excel, yo tengo los dos procedimientos instalados y uso el que más me conviene, espero les sirva.
Te recomiendo que leas un excelente libro sobre Excel el que te ayudará manejar las planillas de cálculo, debes hacer click acá.






Function Letra(Numero)
Dim Texto
Dim Millones
Dim Miles
Dim Cientos
Dim Decimales
Dim Cadena
Dim CadMillones
Dim CadMiles
Dim CadCientos
Dim caddecimales
Texto = Round(Numero, 2)
Texto = FormatNumber(Texto, 2)
Texto = Right(Space(14) & Texto, 14)
Millones = Mid(Texto, 1, 3)
Miles = Mid(Texto, 5, 3)
Cientos = Mid(Texto, 9, 3)
Decimales = Mid(Texto, 13, 2)
CadMillones = ConvierteCifra(Millones, False)
CadMiles = ConvierteCifra(Miles, False)
CadCientos = ConvierteCifra(Cientos, True)
caddecimales = ConvierteDecimal(Decimales)
If Trim(CadMillones) > "" Then
If Trim(CadMillones) = "un " Then
Cadena = CadMillones & " millón "
Else
Cadena = CadMillones & " millones "
End If
End If
If Trim(CadMiles) > "" Then
If Trim(CadMiles) = "un " Then
CadMiles = ""
Cadena = Cadena & "" & CadMiles & " mil "
CadMiles = "un"
Else
Cadena = Cadena & " " & CadMiles & " mil "
End If
End If
If Trim(CadMiles) > "001" Then
CadMiles = "mil "
End If
If Decimales = "00" Then
If Trim(CadMillones & CadMiles & CadCientos & caddecimales) = "un " Then
Cadena = Cadena & "uno "
Else
If Miles & Cientos = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos)
Else
Cadena = Cadena & " " & Trim(CadCientos)
End If
Letra = Trim(Cadena)
End If
Else
If Trim(CadMillones & CadMiles & CadCientos & caddecimales) = "un " Then
Cadena = Cadena & "uno" & "con " & Trim(caddecimales)
Else
If Millones & Miles & Cientos & Decimales = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos) & " con " & Trim(Decimales) & "/100"
Else
Cadena = Cadena & " " & Trim(CadCientos) & " con " & Trim(Decimales) & "/100"
End If
Letra = Trim(Cadena)
End If
End If
End Function
Private Function ConvierteCifra(Texto, IsCientos As Boolean)
Dim Centena
Dim Decena
Dim Unidad
Dim txtCentena
Dim txtDecena
Dim txtUnidad
Centena = Mid(Texto, 1, 1)
Decena = Mid(Texto, 2, 1)
Unidad = Mid(Texto, 3, 1)
Select Case Centena
Case "1"
txtCentena = "cien"
If Decena & Unidad <> "00" Then
txtCentena = "ciento"
End If
Case "2"
txtCentena = "doscientos"
Case "3"
txtCentena = "trescientos"
Case "4"
txtCentena = "cuatrocientos"
Case "5"
txtCentena = "quinientos"
Case "6"
txtCentena = "seiscientos"
Case "7"
txtCentena = "setecientos"
Case "8"
txtCentena = "ochocientos"
Case "9"
txtCentena = "novecientos"
End Select
Select Case Decena
Case "1"
txtDecena = "diez"
Select Case Unidad
Case "1"
txtDecena = "once"
Case "2"
txtDecena = "doce"
Case "3"
txtDecena = "trece"
Case "4"
txtDecena = "catorce"
Case "5"
txtDecena = "quince"
Case "6"
txtDecena = "dieciseis"
Case "7"
txtDecena = "diecisiete"
Case "8"
txtDecena = "dieciocho"
Case "9"
txtDecena = "diecinueve"
End Select
Case "2"
txtDecena = "veinte"
If Unidad <> "0" Then
txtDecena = "veinti"
End If
Case "3"
txtDecena = "treinta"
If Unidad <> "0" Then
txtDecena = "treinta y "
End If
Case "4"
txtDecena = "curenta"
If Unidad <> "0" Then
txtDecena = "cuarenta y "
End If
Case "5"
txtDecena = "cincuenta"
If Unidad <> "0" Then
txtDecena = "cincuenta y "
End If
Case "6"
txtDecena = "sesenta"
If Unidad <> "0" Then
txtDecena = "sesenta y "
End If
Case "7"
txtDecena = "setenta"
If Unidad <> "0" Then
txtDecena = "setenta y "
End If
Case "8"
txtDecena = "ochenta"
If Unidad <> "0" Then
txtDecena = "ochenta y "
End If
Case "9"
txtDecena = "noventa"
If Unidad <> "0" Then
txtDecena = "noventa y "
End If
End Select
If Decena <> "1" Then
Select Case Unidad
Case "1"
If IsCientos = False Then
txtUnidad = "un "
Else
txtUnidad = "uno "
End If
Case "2"
txtUnidad = "dos "
Case "3"
txtUnidad = "tres"
Case "4"
txtUnidad = "cuatro "
Case "5"
txtUnidad = "cinco "
Case "6"
txtUnidad = "seis "
Case "7"
txtUnidad = "siete "
Case "8"
txtUnidad = "ocho "
Case "9"
txtUnidad = "nueve"
End Select
End If
ConvierteCifra = txtCentena & " " & txtDecena & txtUnidad
End Function

Private Function ConvierteDecimal(Texto)
Dim Decenadecimal
Dim Unidaddecimal
Dim txtDecenadecimal
Dim txtUnidaddecimal
Decenadecimal = Mid(Texto, 1, 1)
Unidaddecimal = Mid(Texto, 2, 1)
Select Case Decenadecimal
Case "1"
txtDecenadecimal = "diez"
Select Case Unidaddecimal
Case "1"
txtDecenadecimal = "once"
Case "2"
txtDecenadecimal = "doce"
Case "3"
txtDecenadecimal = "trece"
Case "4"
txtDecenadecimal = "catorce"
Case "5"
txtDecenadecimal = "quince"
Case "6"
txtDecenadecimal = "dieciseis"
Case "7"
txtDecenadecimal = "diecisiete"
Case "8"
txtDecenadecimal = "dieciocho"
Case "9"
txtDecenadecimal = "diecinueve"
End Select
Case "2"
txtDecenadecimal = "veinte"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "veinti"
End If
Case "3"
txtDecenadecimal = "treinta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "treinta y "
End If
Case "4"
txtDecenadecimal = "cuarenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "cuarenta y "
End If
Case "5"
txtDecenadecimal = "cincuenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "cincuenta y"
End If
Case "6"
txtDecenadecimal = "sesenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "sesenta y"
End If
Case "7"
txtDecenadecimal = "setenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "setenta y "
End If
Case "8"
txtDecenadecimal = "ochenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "ochenta y "
End If
Case "9"
txtDecenadecimal = "noventa"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "noventa y"
End If
End Select
If Decenadecimal <> "1" Then
Select Case Unidaddecimal
Case "1"
txtUnidaddecimal = "uno"
Case "2"
txtUnidaddecimal = "dos"
Case "3"
txtUnidaddecimal = "tres"
Case "4"
txtUnidaddecimal = "cuatro"
Case "5"
txtUnidaddecimal = "cinco"
Case "6"
txtUnidaddecimal = "seis"
Case "7"
txtUnidaddecimal = "siete"
Case "8"
txtUnidaddecimal = "ocho"
Case "9"
txtUnidaddecimal = "nueve"
End Select
End If
If Decenadecimal = 0 And Unidaddecimal = 0 Then
ConvierteDecimal = ""
Else
ConvierteDecimal = txtDecenadecimal & txtUnidaddecimal
End If
End Function



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página click para descargar.




If this post was helpful INVITE ME A COFFEE and so help keep up the page.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends