Instrucción With End With en macro




La instrucción With ... End With sirve para ejecutar instrucciones sobre un objeto específico sin necesidad de hacer referencia al objeto varias veces; la sintaxis es:

Objeto  dato obligatorio, es el objeto al que se hace referencia
Instrucciones instrucciones que se van a realizar sobre el objeto


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.


  

Normalmente se usa modificar las propiedades a los objetos como por ejemplo en el código que se encuentra debajo se da una serie de instrucciones para configurar el objeto Sheet (hoja de Excel), estableciendo el área de impresión, margenes, centrado, orientación de la página etc. como se observa se escribe unas sola vez el nombre del objeto y luego dentro de la estructura With ... End With se escriben los distintos códigos que dan las propiedades al objeto.

Desde el código del final descarga el ejemplo que configura la hoja de excel utilizando la estructura With ... End With.

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 seleccionarlas, buscar en listbox mientras escribes en textbox, ordenar hojas libro excel por su nombre, conectar Excel con Access y muchos ejemplos más.






Código que se inserta en un módulo



Sub ConfigurarPágina()
'La propiedad a False es para acelerar la ejecución de código que establece PageSetup propiedades
' Verdador, si la comunicación con la impresora está encendida; de lo contrario False
    Application.PrintCommunication = False
    
    With ActiveSheet.PageSetup
    'Repite la primer y segunda fila en todas las hojas
        .PrintTitleRows = "$1:$2"
    'Repite la columna A y B en todas las hojas
        .PrintTitleColumns = "$A:$B"
    End With
    Application.PrintCommunication = True
    'Establece area de impresión entre A1  e I20
    ActiveSheet.PageSetup.PrintArea = "$A$1:$I$20"
    Application.PrintCommunication = False
    
    With ActiveSheet.PageSetup
    'Establece el encabezado a la izquierda de la página como página x  de j páginas
        .LeftHeader = "&P&N"
    'Establece el encabezado centrado en la página en blanco
        .CenterHeader = ""
    'Establece el encabezado a la derecha de la página en blanco
        .RightHeader = ""
    'Establece el pie de pagina a la izquierda de la página en blanco
        .LeftFooter = ""
    'Establece el pie de pagina centrado en la página como página x  de j páginas
        .CenterFooter = "Página &P"
    'Establece el pie de pagina a la derecha de la página en blanco
        .RightFooter = ""
    'Establece el margen izquierdo en pulgadas
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
    'Establece el margen derecho en pulgadas
        .RightMargin = Application.InchesToPoints(0.708661417322835)
    'Establece el margen superior en pulgadas
        .TopMargin = Application.InchesToPoints(0.748031496062992)
    'Establece el margen inferior en pulgadas
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
    'Establece el margen del encabezado en pulgadas
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
    'Establece el margen del pie de páginas en pulgadas
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
     'Establece el margen izquierdo en centimetros
        .LeftMargin = Application.CentimetersToPoints(1.5)
    'Establece el margen derecho en centimetros
        .RightMargin = Application.CentimetersToPoints(1.5)
    'Establece el margen superior en centimetros
        .TopMargin = Application.CentimetersToPoints(1.5)
    'Establece el margen inferior en centimetros
        .BottomMargin = Application.CentimetersToPoints(1.5)
    'Establece el margen del encabezado en centimetros
        .HeaderMargin = Application.CentimetersToPoints(0.8)
    'Establece el margen del pie de páginas en centimetros
        .FooterMargin = Application.CentimetersToPoints(0.8)
    'No imprime encabezados
        .PrintHeadings = False
    'Imprime líneas de división
        .PrintGridlines = True
    'No imprime líneas de división
        .PrintComments = xlPrintNoComments
    'Establece calidad de impresión puede ser 300, 1200, 2400
        .PrintQuality = 600
    'No centra horizontalmente
        .CenterHorizontally = False
    'No centra verticalmente
        .CenterVertically = False
    'Horientación vertical de la hoja
        .Orientation = xlPortrait
    'Horientación horizontal de la hoja
        .Orientation = xlLandscape
     'Calidad borrador falso, puede ser true
        .Draft = False
     'Primero número de página, en este caso es automático. pero puede ser 1,2 4 o el número que sea
        .FirstPageNumber = xlAutomatic
     'Primero número de página es 4
        .FirstPageNumber = 4
     'Primero imprime hacia abajo y luego derecha
        .Order = xlDownThenOver
     'Imprime en Banco y Negro
        .BlackAndWhite = True
     ' Ajusta a una página de ancho
        .FitToPagesWide = 1
     ' Ajusta a tres página de alto
        .FitToPagesTall = 3
     'Escala de impresión se puede reducir a un porcentaje X, en este caso es falso
        .Zoom = False
     'Si se utiliza zoom y puede disminuir en un x porcentaje la configuración de la página
        .Zoom = 100
     'Establece si imprimer errores
        .PrintErrors = xlPrintErrorsDisplayed
     'Paginas pares e impares diferentes
        .OddAndEvenPagesHeaderFooter = False
     'Primer página diferente
        .DifferentFirstPageHeaderFooter = False
     'Ajusta la scala con el documento
        .ScaleWithDocHeaderFooter = True
     'Alinea con márgenes de página
        .AlignMarginsHeaderFooter = True
     'Aplicar encabezado a todas las páginas alineado izquierda
        .EvenPage.LeftHeader.Text = ""
     'Aplicar encabezado a todas las páginas alineado centrado
        .EvenPage.CenterHeader.Text = ""
     'Aplicar encabezado a todas las páginas alineado derecha
        .EvenPage.RightHeader.Text = ""
     'Aplicar pie de pagina a todas las páginas alineado izquierda
        .EvenPage.LeftFooter.Text = ""
     'Aplicar pie de pagina a todas las páginas alineado centrado
        .EvenPage.CenterFooter.Text = ""
     'Aplicar pie de pagina a todas las páginas alineado derecha
        .EvenPage.RightFooter.Text = ""
     'Aplicar encabezado a la primer página alineado izquierda
        .FirstPage.LeftHeader.Text = ""
     'Aplicar encabezado a la primer página alineado centrado
        .FirstPage.CenterHeader.Text = ""
     'Aplicar encabezado a la primer página alineado derecha
        .FirstPage.RightHeader.Text = ""
      'Aplicar pie de pagina a la primer página alineado izquierda
        .FirstPage.LeftFooter.Text = ""
      'Aplicar pie de pagina a la primer página alineado centrado
        .FirstPage.CenterFooter.Text = ""
      'Aplicar pie de pagina a la primer página alineado derecha
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    'Vuelve a establecer los saltos de página
    ActiveSheet.ResetAllPageBreaks
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      

Como usar intrucción Select Case en macro




La instrucción Select ...Case...End Select permite ejecutar uno o entre un conjunto de códigos, dependiendo de la coincidencia entre la expresión a evaluar y la lista de expresiones Case, esta instrucción puede ser anidada; la sintaxis es:

Select Case expresión a evaluar
Case lista expresiones
Intrucciones
Case Else
Instrucciones Else
End Select

Expresión a evaluar: dato obligatorio, expresión numérica o string.
Lista de expresiones: Puede ser un valor o intervalos de valores, para expresar un intervalo se utiliza To, por ejemplo Case 2, 5 to 9, 15 Is > MinímoValor; para que el valor sea tomado como verdadero debe ser menor al valor To.
Se puede usar una cadena de caracteres específicos o un intervalo, por ejemplo Case Is "Juan", Jorge to Horacio; en el caso anterior se evaluará como verdadera toda cadena de caracteres que coincida con Juan y cadena de caracteres que estén entre Jorge y Horacio en orden alfabético.
En caso que la expresión evaluada coincida con la lista de expresiones de varias cláusulas Case, se ejecutará la primera coincidencia solamente.
Instrucciones: comandos que se deben realizar en caso se que la expresión sea evaluada como verdadera y se ejecutan hasta la próxima clausula Case o hasta el final en caso de ser la última clausula Case.
Instrucciones Else: es opcional, son las instrucciones que se deben ejecutar en caso que ninguna expresión sea verdadera, es recomendable agregar dicha instrucción para controlar expresiones que no sean verdaderas.

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.


  

En la codificación que se encuentra más abajo se puede ver el uso de la Instruccion Select Case; se observa que a la variable FormFile se le ha dado un valor igual a 10, pero puede ser otro o surgir del resultado de otra codificación previa; la primera expresión Case será verdadera si la variable FormFile estuviera entre a 1 y 6  o fuera igual a 9, como el valor de la variable es 10 entonces el valor es falso y pasa a evaluar las expresión de la siguiente clausula Case que en el ejemplo al ser igual a 10 se ejecutarán las instrucciones establecidas para ese Case hasta el siguiente Case o hasta el final de la instrucción que está dado por End Select; en el ejemplo solo llama a una macro llamada  GuardarOrigenTomy; si ninguna de las expresiones hubiera sido verdadera se ejecutará lo que se establece en la instrucción Case Else.

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 seleccionarlas, buscar en listbox mientras escribes en textbox, ordenar hojas libro excel por su nombre, conectar Excel con Access y muchos ejemplos más.






Código que se inserta en un módulo



Sub CopyFol()
FormFile= 10
Select Case FormFile
Case Is = 1 to 7, 9
Call GuardaOrigenNeda
Case Is = 10
Call GuardarOrigenTomy
Case Else
CallOtro
End Select
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      

Como usar If Then Else en macro




La instrucción If ...Then...Else se utiliza para ejecutar uno o varios códigos determinados,  pero dependiendo de una condición; se puede anidar tantas funciones If ...Then...Else como se necesiten, pero es más eficiente cuando se debe analizar muchas condiciones utilizar Select Case, que se verá en otro post.

Cuando se debe ejecutar una sola instrucción después de evaluar una condición se puede usar una forma sencilla como: If condición Then código a realizar.

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.

Ahora bien, cuando después de evaluar la condición, se deben realizar varias condiciones se debe usar la siguiente forma:

If condición Then

código 

Else (opcional)

código

End If


En caso que no se cumpla la condición se puede establecer que se debe realizar en caso contrario, para ello se utiliza Else; es decir se evalúa la condición en caso verdadero se ejecuta un código en caso contrario (Else) se ejecuta otro código, para terminar se debe utilizar End If, caso contrario el código podría no comportarse como se requiere o podría producir un error de sintaxis.


  

En los siguientes link encontrarás ejemplos del uso de If ...Then...Else:

Instrucción If ...Then...Else anidada

Formulario Ingreso y Egreso de Stock, encontraras en varias partes del código el uso de la Instrucción If ...Then...Else 

En este link encontrarás otra gran cantidad de ejemplos que usan la Instrucción If ...Then...Else 

El código que se encuentra a continuación pertenece a un ejemplo de macro que tiene por finalidad llenar un combobox y luego sumar los datos repetidos, descargar desde este link, se podrá observar también el uso de la instrucción bajo estudio, donde también se usa otra instrucción For...Next.

Suscribe al blog para recibir en tu correo todas las actualizaciones, dispones también de un canal de You Tube donde encontrarás explicaciones de macros con mayor detalle.

Código que se inserta en un módulo



Public nomlibro, dire, dire1, p As String 
Private Sub ComboBox1_Change()
Range("r2:u3") = ClearContents
If ComboBox2 = Empty Then
MsgBox ("Debe seleccionar Nombre"), vbInformation, "AVISO"
ComboBox2.SetFocus
Exit Sub
End If
ComboBox2_Change
End Sub
Private Sub ComboBox2_Change()
On Error Resume Next
Application.ScreenUpdating = False
Dim uf, ufcat, filadir, filacat, contad, contap, contadc, contamc As Integer
Range("r2:u3") = ClearContents

If ComboBox1 = Empty Then
MsgBox ("Debe seleccionar Nombre"), vbInformation, "AVISO"
ComboBox1.SetFocus
Exit Sub
End If

dire = ComboBox2
nomlibro = ActiveWorkbook.Name
p = ActiveWorkbook.Path
dire1 = p & "\" & nomlibro

If dire = dire1 Then
        TextBox1 = Clear
        TextBox2 = Clear
        TextBox3 = Clear
        TextBox4 = Clear
        
        
        contad = 0
        contap = 0
        contadc = 0
        contamc = 0
        perfind = ComboBox1
        ufcat = Sheets("Proyectos").Range("H" & Rows.Count).End(xlUp).Row
        
        For i = 2 To ufcat
        a = Sheets("Proyectos").Cells(i, 6)
        If a = perfind Then contad = contad + 1
        If Sheets("Proyectos").Cells(i, 7) = perfind And Sheets("Proyectos").Cells(i, 8) = Sheets("Proyectos").Cells(1, 19) Then contap = contap + 1
        If Sheets("Proyectos").Cells(i, 7) = perfind And Sheets("Proyectos").Cells(i, 8) = Sheets("Proyectos").Cells(1, 20) Then contadc = contadc + 1
        If Sheets("Proyectos").Cells(i, 7) = perfind And Sheets("Proyectos").Cells(i, 8) = Sheets("Proyectos").Cells(1, 21) Then contamc = contamc + 1
        Next i
        
        If nomlibro <> dire Then
        Sheets("Proyectos").Cells(2, 18) = contad
        Sheets("Proyectos").Cells(2, 19) = contap
        Sheets("Proyectos").Cells(2, 20) = contadc
        Sheets("Proyectos").Cells(2, 21) = contamc
        
        Else
        
        Sheets("Proyectos").Cells(3, 18) = contad
        Sheets("Proyectos").Cells(3, 19) = contap
        Sheets("Proyectos").Cells(3, 20) = contadc
        Sheets("Proyectos").Cells(3, 21) = contamc
        End If
        
        TextBox1 = contad
        TextBox2 = contap
        TextBox3 = contadc
        TextBox4 = contamc
Else
  Application.Workbooks.Open dire
  Sheets("Proyectos").Select
        TextBox1 = Clear
        TextBox2 = Clear
        TextBox3 = Clear
        TextBox4 = Clear
            
        contad = 0
        contap = 0
        contadc = 0
        contamc = 0
        
        perfind = ComboBox1
        ufcat = Sheets("Proyectos").Range("H" & Rows.Count).End(xlUp).Row
        
        For i = 2 To ufcat
        a = Sheets("Proyectos").Cells(i, 6)
        If a = perfind Then contad = contad + 1
        If Sheets("Proyectos").Cells(i, 7) = perfind And Sheets("Proyectos").Cells(i, 8) = Sheets("Proyectos").Cells(1, 19) Then contap = contap + 1
        If Sheets("Proyectos").Cells(i, 7) = perfind And Sheets("Proyectos").Cells(i, 8) = Sheets("Proyectos").Cells(1, 20) Then contadc = contadc + 1
        If Sheets("Proyectos").Cells(i, 7) = perfind And Sheets("Proyectos").Cells(i, 8) = Sheets("Proyectos").Cells(1, 21) Then contamc = contamc + 1
        Next i
        
        If dire = dire1 Then
        Sheets("Proyectos").Cells(2, 18) = contad
        Sheets("Proyectos").Cells(2, 19) = contap
        Sheets("Proyectos").Cells(2, 20) = contadc
        Sheets("Proyectos").Cells(2, 21) = contamc
        
        Else
        ActiveWorkbook.Close False
        Sheets("Proyectos").Cells(3, 18) = contad
        Sheets("Proyectos").Cells(3, 19) = contap
        Sheets("Proyectos").Cells(3, 20) = contadc
        Sheets("Proyectos").Cells(3, 21) = contamc
        End If
        
        TextBox1 = contad
        TextBox2 = contap
        TextBox3 = contadc
        TextBox4 = contamc
End If
Application.ScreenUpdating = True
End Sub


Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
ComboBox1.Clear
Sheets("Nom").Select
Range("A2").Select
While ActiveCell <> Empty
ComboBox1.AddItem ActiveCell
ActiveCell.Offset(1, 0).Select
Wend
ComboBox2.Clear
Sheets("Archivo").Select
Range("A2").Select
While ActiveCell <> Empty
ComboBox2.AddItem ActiveCell
ActiveCell.Offset(1, 0).Select
Wend
Sheets("Proyectos").Select
Application.ScreenUpdating = True
End Sub

Código a insertar en un módulo

Sub cargaform()
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      

Como utilizar GoTo en Macro




La instrucción GoTo es utilizada por los programadores, en una macro o procedimiento de VBA para saltar a una linea especificada del código.

En la practica se usa para saltar un bucle y cuando un dato especifico sea encontrado o se cumpla una condición, etc. y de esta manera saltar una serie de instrucciones que no se aplican a ese dato, en resumen con GoTo se va a una linea determinada del código.

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.

Siguiendo con el desarrollo de la Instrucción GoTo, tiene como desventaja que solo salta a etiquetas o líneas del procedimiento donde se inserta o aparece GoTo no a otro procedimiento distinto, por ejemplo se puede utilizar así:

Salta a la etiqueta salir, se debe especificar el nombre de la etiqueta a donde saltará el código; se usa este código:

GoTo salir:

... código

salir:



  

En el siguiente ejemplo verás el uso de GoTo para saltar de un bucle y cuando aparece el registro "Tomy Lee" o "Dayra Col" no se tienen en cuenta, saltando el bucle y no aplicando el código establecido a dichos registros, en otras palabras a los demás registros los resalta y a los registros mencionado no aplica color a la fila.

Al descargar el ejemplo desde el link del final del post, se puede observar tres botones, el primer botón utiliza el GoTo, el segundo no lo utiliza y se agrega a los fines de que se pueda observar la diferencia, el tercer botón borra el resaltado de las filas.

También puedes observar la explicación nuestro canal de You Tube, suscribe para recibir en tu correo vídeos explicativos sobre otras macros interesantes que se publiquen, como  por ejemplo formulario que crea un listado de todas las hojas para poder luego seleccionarlas, buscar en listbox mientras escribes en textbox, ordenar hojas libro excel por su nombre, conectar Excel con Access y muchos ejemplos más.






Código que se inserta en un módulo



Sub UsoGoTo()
Dim clie As New Collection, celda As Object, dato
Dim fila As Integer, j As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
uf = Range("A" & Rows.Count).End(xlUp).Row
r1 = "A2" & ":A" & uf
For Each celda In Range(r1)
clie.Add celda.Value, CStr(celda.Value)
Next celda
fila = 2
j = 255
For Each dato In clie
Do
If Cells(fila, "A") = dato Then
If dato = "Tomy Lee" Or dato = "Dayra Col" Then GoTo jump:
Range("A" & fila & ":E" & fila).Interior.Color = j
End If
jump:
fila = fila + 1
Loop While fila <= uf
j = j + 60000
fila = 2
Next dato
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub SinUsoGoTo()
Dim clie As New Collection, celda As Object, dato
Dim fila As Integer, j As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
uf = Range("A" & Rows.Count).End(xlUp).Row
r1 = "A2" & ":A" & uf
For Each celda In Range(r1)
clie.Add celda.Value, CStr(celda.Value)
Next celda
fila = 2
j = 255
For Each dato In clie
Do
If Cells(fila, "A") = dato Then
Range("A" & fila & ":E" & fila).Interior.Color = j
End If
fila = fila + 1
Loop While fila <= uf
j = j + 60000
fila = 2
Next dato
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Sub quitaformato()
uf = Range("A" & Rows.Count).End(xlUp).Row
Range("A2" & ":E" & uf).Interior.Color = xlNone
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