Jump to content

AlexanderS

Moderators
  • Content Count

    1,378
  • Joined

  • Last visited

  • Days Won

    57

Posts posted by AlexanderS

  1. @Leonardo Briceño Pura vida!!

    A mi no me pasa lo que indicas, pero de igual forma puedes probar solo des protegiendo la hoja cuando confirmas la eliminación de esta forma no deberías ver las formulas cuando se muestren los cuadros de mensaje.

     

    Sub BorrarCeldas(): On Error GoTo ExitSub
    Set CeldaDestino = Application.InputBox("SELECCIONE LA CELDA CON EL NOMBRE QUE DESEA ELIMINAR", _
                      "BORRAR - SELECCIONE CELDA", Type:=8)
                      Application.ScreenUpdating = False
                      CeldaDestino.Worksheet.Select
                      CeldaDestino.Select
    If MsgBox("DESEA ELIMINAR EL NOMBRE " & ActiveCell.Value, vbQuestion + vbYesNo) = vbYes Then
       If MsgBox("¿ESTÁ SEGURO?", vbQuestion + vbYesNo) = vbYes Then
       ActiveSheet.Unprotect Password:="123"
          Range("A" & ActiveCell.Row).Resize(1, 2).ClearContents
          Range("D" & ActiveCell.Row).Resize(1).ClearContents
          Range("F" & ActiveCell.Row).Resize(1).ClearContents
          Range("J" & ActiveCell.Row).Resize(1).ClearContents
          MsgBox ("NOMBRE ELIMINADO SATISFACTORIAMENTE")
          ActiveSheet.Protect ("123")
          Exit Sub
          End If
    End If
    ExitSub:
       MsgBox "¡OPERACIÓN CANCELADA!", vbExclamation
    ActiveSheet.Protect ("123")
    End Sub

    Saludos

  2. @Leonardo Briceño, por lo que veo no estas volviendo a proteger la hoja luego de eliminar, solo la proteges si se cancela.

    Así debería funcionar: 

    Sub BorrarCeldas(): On Error GoTo ExitSub
    ActiveSheet.Unprotect Password:="123"
    Set CeldaDestino = Application.InputBox("SELECCIONE LA CELDA CON EL NOMBRE QUE DESEA ELIMINAR", _
                      "BORRAR - SELECCIONE CELDA", Type:=8)
                      Application.ScreenUpdating = False
                      CeldaDestino.Worksheet.Select
                      CeldaDestino.Select
    If MsgBox("DESEA ELIMINAR EL NOMBRE " & ActiveCell.Value, vbQuestion + vbYesNo) = vbYes Then
       If MsgBox("¿ESTÁ SEGURO?", vbQuestion + vbYesNo) = vbYes Then
          Range("A" & ActiveCell.Row).Resize(1, 2).ClearContents
          Range("D" & ActiveCell.Row).Resize(1).ClearContents
          Range("F" & ActiveCell.Row).Resize(1).ClearContents
          Range("J" & ActiveCell.Row).Resize(1).ClearContents
          MsgBox ("NOMBRE ELIMINADO SATISFACTORIAMENTE")
          ActiveSheet.Protect ("123") '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
          Exit Sub
          End If
    End If
    ExitSub:
       MsgBox "¡OPERACIÓN CANCELADA!", vbExclamation
    ActiveSheet.Protect ("123")
    End Sub

    Saludos

  3. Hola @Leonardo Briceño, en este caso seria convertir tanto la búsqueda como el nombre de las hojas a mayúsculas independientemente de como estén escritas:

    Sub BuscarNombreHoja()
    
    Application.ScreenUpdating = False
        Dim existe As Boolean
        Dim nombreHoja As String
        Dim cont As Integer
        nombreHoja = UCase(InputBox("INGRESE EL NOMBRE DE LA HOJA"))
        existe = False
        For cont = 1 To Worksheets.Count
            If UCase(Worksheets(cont).Name) Like "*" & nombreHoja & "*" Then
                existe = True
                Exit For
            End If
        Next
        If existe = False Then
            MsgBox "NO SE ENCONTRÓ EL NOMBRE INGRESADO!"
        Else
             Sheets(Worksheets(cont).Name).Select
        End If
    End Sub

    Lo logras con UCASE().

    Saludos 

  4. Hace 8 minutos , Nori777 dijo:

    Gracias AlexanderS. No puedo porobarlo por el error '1004' que incluí en mi contestación anterior a Luis Caballero. Cuando alguien me ayude a depurarlo lo probaré y te diré el resultado.

    Gracias

     

    Un saludo

    Pero probaste abrir el archivo y ejecutar la macro?, el error 1004 regularmente es porque un nombre no definido o alguna comilla faltante etc.

  5. @RadioViraje73, correcto la instrucción copiara los datos en columnas contiguas, entonces tienes algunas opciones: 1 utilizar un ciclo while para leer cada columna de tu tabla individualmente o 2 realizar una consulta a por cada columna para poder utilizar el .CopyFromRecordset, algo como esto:

    Columnas = Array("FECHA", "PAGADO", "DEBE")
    
    For Each param In Columnas
    
    Sql = Replace("SELECT ? FROM [Datos$] where (FECHA BETWEEN #1/1/2020# and #31/3/2020#) and DEBE >0", "?", param)
    
    Rst.Open Sql, cn, 3, 3
    
    Select Case param
    Case Is = "FECHA": Sheets("Resultado").Range("A2").CopyFromRecordset Rst
    Case Is = "PAGADO": Sheets("Resultado").Range("B2").CopyFromRecordset Rst
    Case Is = "DEBE": Sheets("Resultado").Range("F2").CopyFromRecordset Rst
    
    End Select
    Rst.Close
    Next

    Adjunto un pequeño ejemplo, en mi caso la tabla esta en el mismo libro.

    Obviamente es mas rápido utilizar un ciclo para leer 3 columnas que uno para leer X cantidad de filas. 

    Comentas, saludos. 

    Ejem SQL.xlsm

  6. Hola @darkstars9976, prueba este código y me comentas.

    Sub Copia_recetas()
        Dim Rng$, x#
        Dim rept        As Range
        Dim celda
        With Sheets("BD_Recetas")
            
            Rng = .Range("D1")
            
            x = 9
            
            For Each celda In Sheets("Proy.-Comer").Range(Rng)
                
                If celda <> "" Then
                    Set rept = .Range("C9:C43").Find(celda, , , xlWhole)
                    
                    If rept Is Nothing Then _
                       .Cells(x, "C") = celda: x = x + 1
                    
                End If
            Next
            
        End With
        
    End Sub

    Saludos.

  7. Has probado o tienes información sobre Power Pivot ?, si lo que haces simplemente es un exportación de los datos de access a excel no necesitas ninguna macro excel es capas de realizar la exportación a una tabla plana o dinámica, ademas si utilizas Power Pivot puedes crear las "formulas" internamente.

    Pero solo estoy suponiendo ya que desconozco la estructura de tu base ni lo que quieres hacer en excel. 

    Si te parece puedes subir un ejemplo del accces y el excel, obviamente con datos ficticios pero con un formato fiel al original para que no tengas problemas para adaptarlo.

    Saludos.

  8. Hola @Nori777, no se si entendí pero puedes probar con este código:

    Sub registrar()
        Dim jugador     As Range
        Dim Franjas     As Variant
        
        jug = Sheets("Hoja2").Range("Q36")
        
        With Sheets("Hoja1")
            
            Set jugador = .Range("BD:BD").Find(jug, , , xlWhole)
            
            If jugador Is Nothing Then Exit Sub
            
            ult = jugador.End(xlDown).Offset(0, 1).End(xlUp).Row + 1
            
            .Cells(ult, "BE") = Sheets("Hoja2").Range("M36")
            .Cells(ult, "BF") = Sheets("Hoja2").Range("O36")
            
            Franjas = Sheets("Hoja2").Range("L40:Q40")
            
            .Range(.Cells(ult, "BG"), .Cells(ult, "BL")) = Franjas
            
        End With
        
    End Sub

     Funciona en el ultimo archivo que subiste de ejemplo

    Por las dudas dejo el archivo también.

    Saludos a todos!

    Consulta.xlsm

  9. @jomunozta, tal como dice Cristian, recuerda que las fechas y horas en realidad son números con decimales y bueno por la forma de excel de tratar operaciones con números flotantes obtendrás un resultado con decimales.

    Puedes limitar el numero de decimales que debe devolver el resultado a 2 así el 7.99999999999 se convertirá en un 8.00.

    image.thumb.png.33cb2d6655f6b780b9e978a11891116d.png

    Y en este otro caso el resultado sera 1.50

    image.thumb.png.32991d93c2a9bfc259820b4c8f18e2c9.png

    Después es solo cuestión de evaluar esos decimales sin mayores a 0.

    Saludos

  10. Hola @Galactico, en ese caso debes buscar como utilizar los ciclos while, te adjunto un código que recorre un rango de celdas colocando un número aleatorio y con el while indico que la instrucción debe repetirse hasta que el número que entrega sea mayor a 50.

    Sub aleatoreo()
    Dim c As Range
    
    For Each c In Range("A1:A7")
    
        num = 0
        
        While num < 50 ' El ciclo while se repite si num es menor a 50
        
            num = Int((100 * Rnd) + 1) 'Generamos un número aleatorio
        
        Wend
        
        c = num
    
    Next
    
    End Sub

    Saludos.

  11. Hola @MauriciodeAbreu, puedes probar con este código:

    Sub Eliminar_Rango(): On error Resume Next
    Dim Rango As Range
        ActiveSheet.Unprotect "1234"
        
        Set Rango = Application.InputBox("Selecione un rango de celdas para eliminar las filas asociadas a ese rango", Type:=8)
        
        If Not Rango Is Nothing Then Rango.EntireRow.Delete
        
        ActiveSheet.Protect "1234"
        
    End Sub

    Comentas, saludos

  12. Hola @jhon fredy, tus consultas no son claras ( esta y anteriores) por eso no obtienes respuestas. Debes indicar en tus consultas de forma clara la ayuda que necesitas, ademas adjuntar un archivo de excel para poder realizar pruebas ya que casi nadie esta dispuesto a crear un archivo de 0, los datos del ejemplo deben ser ficticios pero fieles al formato original.

    Realiza tus consultas explicando mas claramente el problema, adjunta un ejemplo. Así habrá mas usuarios dispuestos a usar su tiempo en atender tus consultas.

    Saludos.

  13. Bueno eso ya es un proceso normal de excel y el inicio depende de los recursos que este usando tu computadora en ese momento, por eso puede variar, y claro al inicio se ve la última hoja en la que estabas cuando guardaste el libro, si tu macro al ejecutarse cambia de hoja pues veras por un instante la última hoja abierta y después cambiará a la que indicaste en tu macro.

    Claro es más notorio cuando en tu código hay instrucciones como .Select o .Activate, las cuales son totalmente prescindibles y yo no recomiendo usar.

    En resumen no hay forma de evitar ese parpadeo inicial puesto que los eventos de Workbook_Open se ejecutan después de toda la carga del excel. (Al menos que yo sepa)

    Saludos 

×
×
  • Create New...

Important Information

Privacy Policy