Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation since 09/28/2021 in all areas

  1. Sin hipervínculos. Doble-click en cualquier fecha. calendario - años SIN VINCULOS.xlsm
    3 points
  2. Te pongo la macro para que cambies el año en la hoja "HOJA1" y se actualice Si esto cumple... no olvides dar clic en 🤍 calendario - años VINCULOS.xlsm
    3 points
  3. Una alternativa mas, puede ser: =BUSCARV($M6,$B$5:$E$16,COINCIDIR(N$4,$B4:$E4,),0) Saludos!
    3 points
  4. Les dejo este ejercicio para evitar que la Función BuscarV no se altere al insertar una columna que se encuentra dentro del rango de búsqueda. Quizá exista una mejor forma... que será bienvenida. Saludos Ejercicio BuscarV.xlsx
    3 points
  5. Enigma25

    Foco entre formularios

    Hola Benito Por lo que puedo notar es que tienes la llamada al procedimiento Verificar en el evento BeforeUpdate de tu TextBox cuando deberias tenerlo en el evento Change y posteriormente en el evento AfterUpdate es donde validarías tu variable Vr para que si está en false, entonces haga la llamada al formulario para registrar el nuevo cliente y con ello ya tienes solucionado esa parte. Lo otro es el orden de la tabulaciones de tus controles en donde el primer Frame debe ser 0, el segundo Frame debe ser 1 y el TexBox donde quieres el foco que sea 0 y en ese control con su indice de tabulación 0 tendrás el foco sin problemas. Mis respetos @Gerson Pineda
    3 points
  6. El archivo.. Mi Negocio Foro.xlsm
    2 points
  7. En la opción de Proteger, quita la selección a las dos primeras opciones.
    2 points
  8. si tu NB corre macros, podrias intentar con esto (en un modulo de codigo estandar -excel-) Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _ ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Sub TeladoVirtual() ShellExecute 0, "open", "osk.exe", "", "", 1 End Sub si no te funciona con "osk.exe" prueba cambiando a "tabtip.exe"
    2 points
  9. Janlui

    Macro no funciona

    Cambia & por AND
    2 points
  10. Esa misma lógica es la que tienes que aplicar en Power Query o Query Editor de PBI, agregando una columna personalizada Hay una leve diferencia respecto a la sintaxis, tal que: = if [campo] < 300 then 0 else if [campo] < 401 then 100 etc.... Saludos!
    2 points
  11. En el formulario de Cambiar y remplazar, pasa a Opciones y activa:Coincidir con el contenido de toda la Celda.
    2 points
  12. Recomendaría trabajar con el nombre del Objeto WorkSheets y emplear un bucle For Next como verás a continuación y con ello tendrías "Menos lineas de código" que es mas o menos lo que creo que esperas hacer. Dim I As Integer With Hoja1 For I = 1 To 5 .Cells(1, I).AddComment .Cells(1, I).Comment.Text Text:="Titulo " & I .Cells(1, I).Comment.Visible = False If I = 3 Then I = I + 1 Next I End With Espero que sea mas o menos lo que esperas. Mis respetos.
    2 points
  13. Alberto González

    Sumar letras

    Gracias a las personas que tuvieron el interés de proponer una solución al problema de sumar letras. Sus soluciones me ayudaron mucho a crear un solución al problema planteado, con lo doy por concluido el tema. Nunca es tarde para enseñar más cuando hay interés en aprender. Saludos
    2 points
  14. ¡Hola a todos! He visto que una pregunta frecuente es acerca de cómo reducir el tamaño de un archivo. Bueno, hay una causa en específico que puede afectar considerablemente el tamaño de un archivo: El rango de celdas que Excel guarda como usado en cada hoja. Se puede encontrar fácilmente la última celda del rango usado presionando Ctrl+Fin en cualquier hoja. El problema es que en muchos casos la 'última celda' está mucho más allá del rango 'real' de celdas usadas... esto por lo general se debe a aplicar formatos a celdas que luego no se van a usar, lo que hace que luego Excel guarde esas celdas como parte del rango usado y así crece 'misteriosamente' el tamaño del archivo. Este problema en particular me llamó la atención porque he visto muchos archivos que se suben en servidores por fuera del foro porque son demasiado grandes para adjuntarlos acá, pero al abrirlos en algunos casos he visto que son archivos con pocos datos, pero con tamaños descomunales... esto debido a que se está guardando como rango usado en cada hoja una cantidad considerable de celdas que no hacen parte del rango 'real' usado. Bueno, no sé si la explicación sea clara. En todo caso, pensando en algunos de esos casos, escribí esta macro que deberá ayudar a reducir considerablemente el tamaño de dichos archivos 'limpiando' el rango usado y dejando sólo del tamaño del rango 'real' usado . Esta es el código: Edito: La macro que propuse inicialmente, gracias a los aportes de quienes han participado en este tema, ha sido mejorado. Para evitar confusiones, copio acá el código final: Sub Limpiar_rangos() Dim hj As Excel.Worksheet Dim copia$, ffin&, cfin&, TI&, TF& copia = crear_copia(ActiveWorkbook) MsgBox "Se ha creado una copia: " & vbLf & copia, vbInformation With ActiveWorkbook TI = VBA.FileLen(.FullName) For Each hj In .Worksheets ffin = 1 cfin = 1 With hj On Error Resume Next ffin = .UsedRange.Find(what:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row cfin = .UsedRange.Find(what:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Column On Error GoTo 0 If .ProtectContents Then If MsgBox("La hoja " & .Name & " se encuentra protegida." & vbLf & vbLf & _ "No se podrán limpiar los rangos de esta hoja a menos que se desproteja." _ & vbLf & vbLf & "¿Desea desprotegerla antes de continuar?", vbYesNo, _ "¡Hoja protegida!") = vbYes Then If Desproteger(hj) Then Limpiar hj, ffin, cfin Else MsgBox "No se ha desprotegido la hoja.", vbCritical, "¡Clave incorrecta!" End If End If Else Limpiar hj, ffin, cfin End If End With Next hj .Save TF = VBA.FileLen(.FullName) End With MsgBox "Tamaño original: " & VBA.Format(TI, "#,##0") & " bytes." & vbLf & vbLf & _ "Tamaño final: " & VBA.Format(TF, "#,##0") & " bytes." & vbLf & vbLf & _ "El archivo se redujo en: " & VBA.Format(TI - TF, "#,##0") & " bytes" & _ " (" & VBA.FormatPercent(Abs(TI / TF - 1), 2) & ")." End Sub Private Sub Limpiar(ByVal hj As Excel.Worksheet, ByVal ffin As Long, ByVal cfin As Long) With hj With .Range(.Cells(ffin + 1, 1), .Cells(.Rows.Count, 1)).EntireRow If .MergeCells = False Then .Clear End With With .Range(.Cells(1, cfin + 1), .Cells(1, .Columns.Count)).EntireColumn If .MergeCells = False Then .Clear End With End With End Sub Private Function crear_copia(ByVal Libro As Excel.Workbook) As String With Libro .Save crear_copia = .Path & Application.PathSeparator & VBA.Format(VBA.Now, "d-m-yy h-mm ") & .Name .SaveCopyAs crear_copia End With End Function Private Function Desproteger(ByVal hj As Excel.Worksheet) As Boolean On Error Resume Next hj.Unprotect Desproteger = Not VBA.CBool(Err.Number) On Error GoTo 0 End Function[/CODE] Reducir tamaño archivo.zip
    2 points
  15. Prueba y comenta Prueba (1).xlsm
    1 point
  16. Janlui

    Archivos .rtf a excel

    Abre un Modulo ( Alf + F11) y copia la macro, el Archivo TXT colocalo en la misma carpeta donde se encuentyre tu archivo excel. Si observas la macro, procesará el archivo 1.TXT Sub opentxt() Application.ScreenUpdating = False Application.DisplayAlerts = False Range("a1:b1000").ClearContents Dim myfile As Variant, cad As String, fila As Long ruta = ActiveWorkbook.Path ChDir ruta myfile = "1.txt" fname = Dir(myfile) If fname = "" Then MsgBox "No existe archivo en esta carpeta" Exit Sub End If Open myfile For Input As #1 fila = 1 Cells.Clear While Not EOF(1) Line Input #1, cad Cells(fila, 2) = cad fila = fila + 1 Wend Close #1 Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
    1 point
  17. Perdona no fue mi intención no volverá a ocurrir 😬
    1 point
  18. Hola Jeaa Revisé tu form y está trabajando correctamente, solo que creo que hay un procedimiento manual que tienes que implementar, tienes Botón Buscar y Botón Limpiar. Buscas tu primer código, te da los resultados, si vas a cambiar el código de búsqueda el usuario debe limpiar y luego ingresar el codigo y clic en buscar, pero si lo quieres en macros aquí te va una explicación que aprendí ayudaexcel. No se puede asignar una variable en el userform porque estarás "cargando la memoria temporal del excel = Lentitud en procesos". La variable estará aumentando la memoria temporal de excel mientras el userform esté activo Por tal razón, en tu botón buscar agrega esta instrucción en el botón Buscar Private Sub CBbuscar_Click() If Txtcodigo.Value = Empty Then MsgBox "Para realizar una busqueda, es necesario que ingrese un codigo", vbCritical, "Error de Usuario" Txtcodigo.SetFocus Exit Sub Else Call BuscarCodigo End If End Sub En tu módulo de Vba agrega esta instrucción Public Sub BuscarCodigo() Dim codigo As String codigo = ReporteAgua.Txtcodigo.Value Call Mimodulo.limpiar ReporteAgua.Txtcodigo.Value = codigo Call Mimodulo.Buscar End Sub Con esto que te acabo de dar te explico el porque: Cuando habilitas una variable en el modulo de vba, se crea cuando empieza tu macro y luego muere al finalizar la macro, la memoria temporal siempre la tendrás disponible para más consultas sin procesos ralentizados. Espero te sriva. Saludos desde Nicaragua
    1 point
  19. Es fácil amigo, en vez de dejar como imageMso Cámbialo por image Espero haberte ayudado, Saludos, Diego.
    1 point
  20. Hola Gerson. Tengo entendido que las hojas de Entrada y Salida se trasladen a Destino y a la ves, borrarlos de su origen. Estas Hojas pudieran estar filtradas o sin filtro. Finalmente, una ves concentradas en Destino, se deberan ordenar por Referencia e intercalarlas 1 Salida, 1 Entrada... etc. Dejo este otro ejercicio. traslada a destino.xlsm
    1 point
  21. Abre una nueva consulta
    1 point
  22. Recuerda, no debe de tener filtros las hojas de entrada y salida. Espero te sirva traslada a destino.xlsm
    1 point
  23. A la primera pregunta: Label1.BackColor = &O731232 Label1.BackColor = 731232 Label1.BackColor = RGB(73, 12, 32) A la segunda: No, una solución es utilizar un label transparente con una imagen.
    1 point
  24. No olvides dar tu opinión en el corazoncito
    1 point
  25. Alexander, ya encontré cómo hacerlo. Gracias hermano y mucha salud y suerte para usted y su familia. Tema Cerrado.🙂
    1 point
  26. Prueba esto. 'Indicar el libro de Excel destino arch = "nombre " & Year(Now) & ".xlsx" Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "\micarpeta\" & arch)
    1 point
  27. Janlui

    Error al ocultar hojas

    Antes del for each, pon. Sheets("Inicio1").Visible = True Lo ideal es que subas tu archivo para tener mas claridad
    1 point
  28. Revisalo: Horario Diurno... NOCT FEST.xlsx
    1 point
  29. De forma "automática", se puede con una macro de evento, como Change, tal que: Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Column = 1 And .Row < 3 Then result = Range("A1") & " " & Range("A2") Range("A3") = result End If End With End Sub Cada que edites la celda A1 o A2, en la celda A3, se mostrara el resultado concatenado Saludos a ambos!
    1 point
  30. Como te lo comente en el otro lado, es posible que esa sea una tabla independiente de una consulta de power query, es decir si te colocas sobre ella, debe aparecerte en la cinta de opciones, la frase "Consulta", de lo contrario es evidente lo que indicas, que no va actualizar Saludos
    1 point
  31. Para concluir, si este ejercicio no es lo que buscas, ponme el la columna Q manualmente las horas que deberian de ser. NOCT FEST.xlsx
    1 point
  32. Con este ejemplo que te muestro: Como quedaria en la hoja Pagos (Hazlo manualmente y me la mandas)
    1 point
  33. Sub copia_pagos() Set reg = Worksheets("registro") Sheets("Registro").Select Range("D7:D14").Select Selection.Copy Sheets("pagos").Select r = 5 Do While Cells(r, 2) <> "" r = r + 1 Loop For i = r To r + reg.Range("d14") - 1 Cells(i, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Next End Sub
    1 point
  34. Cuando realizas un pago haces referencia al Cliente y este debera validar que exista para completar el resto de los campo, es por eso.
    1 point
  35. Por cuestión de orden y tener éxito en tus procesos automatizados, los catalosgos que en este caso son los Clientes, (Hoja BD) está hecha un desorden, existe omisión en la columna Cliente. 1. Reestructurar BD="Clientes" 2. Columna "A" = ID Cliente 3. Columna "B" = Nombre Cliente 4. Columna "C" = Fecha Alta 5. Columna "D" = Status y posteriormente el resto de los conceptos. Ya que tengas esta Hoja "BD" Clientes, me la mandas y seguimos va? Suerte
    1 point
  36. 1 point
  37. Workbooks(1).Sheets(1).Copy After:=Workbooks(2).Sheets(2) Vale para cualquiera que sean los libros.
    1 point
  38. @Enigma25 Muchas gracias! tema solucionado. Saludos JB
    1 point
  39. El siguiente codigo valida si el nombre coincide con tu variable y si no coincide, inhabilta los botones(controles) de cada una de tus hojas. P. D. Debes tener el mismo nombre del boton(CommandButton1) en cada una de tus hojas para que funcione. Private Sub Workbook_Open() Dim I As Integer Dim nombre As String Dim archivo As String archivo = "C:\carpeta\libro1.xlsm" nombre = ActiveWorkbook.FullName If nombre = archivo Then For I = 1 To Sheets.Count Sheets(I).CommandButton1.Enabled = True Next I MsgBox "Hola Se ha revisado el nombre del libro" Else For I = 1 To Sheets.Count Sheets(I).CommandButton1.Enabled = False Next I MsgBox "No tendra acceso a los formularios" End If End Sub
    1 point
  40. Que gusto Un placer ayudarte.
    1 point
  41. PRUEBA ESTO. Sub TRASLADA() mes = (InputBox("Ingresar número de mes", "Formato: 1,2,3...")) Dim ORIGEN, DESTINO As Workbook Set ORIGEN = ThisWorkbook Sheets(1).Select Range("A1").Select R1 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row Sheets(2).Select Range("A1").Select R2 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row Workbooks.Open ("MILIBRO") Set DESTINO = ActiveWorkbook Sheets(1).Select r = 2 Do While Cells(r, 2) <> "" r = r + 1 Loop DESTINO.Sheets(1).Range("B" & r & ":C" & r + R1 - 2) = ORIGEN.Sheets(1).Range("A2:B" & R1).Value r = 3 Do While Cells(r, 2) <> "" If Cells(r, 1) = "" Then Cells(r, 1) = mes End If r = r + 1 Loop Sheets(2).Select r = 2 Do While Cells(r, 2) <> "" r = r + 1 Loop DESTINO.Sheets(2).Range("B" & r & ":C" & r + R2 - 2) = ORIGEN.Sheets(2).Range("A2:B" & R2).Value r = 3 Do While Cells(r, 2) <> "" If Cells(r, 1) = "" Then Cells(r, 1) = mes End If r = r + 1 Loop End Sub
    1 point
  42. Hola David; He cambiado de evento tal y como comentas y ahora funciona correctamente. Imagino que has podido abrir el archivo cosa que me alegra ya que al parecer había problemas a la hora de abrirlo. Un abrazo y muy gradecido. saludos también a Gerson y Antoni por su ayuda.
    1 point
  43. Ya me he hecho un lio, ¿Qué tiene que ver el formulario del zip3 con el video de la petición? Los archivos se corrompen de 1 en 1, por lo que si tienes alguna copia anterior, lo más probable es que funcione.
    1 point
  44. Gracias Gerson, muy bueno su ejemplo. Menos bueno mi frm que está corrupto. Voy a seguir los pasos que me ha dado Antoni y a ver si definitivamente conseguimos algo. Un abrazo y gracias por su ayuda. 👍
    1 point
  45. Exporta el formulario, elimínalo y sube por separado el archivo Excel, y los archivos .frm y .frx del formulario, la BD no es necesario.
    1 point
  46. Mi método If mes <> Empty Then With Worksheets("Hoja1") .Range("A:A").SpecialCells(4) = mes End With End If o If mes <> Empty Then Worksheets("Hoja1").Range("A:A").SpecialCells(4) = mes Saludos
    1 point
  47. John Jairo V

    Sumar letras

    ¡Hola a todos! En primer lugar, parece que este tema lleva 7 meses de preguntado, por lo que no se si el consultante verá las respuestas que cada uno de ustedes ha posteado. En segundo lugar, el consultante comenta explícitamente que las macros no son permitidas para la solución que se plantee... así que, a pesar que puede servir a modo de ejercicio @Janlui, no creo que sea adoptada tu respuesta. Y, en tercer lugar, pues ya que estamos, demos otra opción con fórmulas matriciales del asunto. ¡Bendiciones! Nota: Mi separador decimal es la ",", por lo que añadí a la fórmula el sustituir la "," por nada para que no se tomara en cuenta como decimal. Si es el caso del consultante en que el separador decimal es el ".", se puede omitir ese sustituir adicional. SumaLetras.xlsx
    1 point
  48. Ponle a la Celda feste formato: en Personalizar #,##0.0 °C
    1 point
  49. Y aquí la segunda: Sub Desagrupar_EliminarColumnas() With Sheets("Plan_update") .Columns.Ungroup Application.ScreenUpdating = False For y = .Cells(5, Columns.Count).End(xlToLeft).Column To 1 Step -1 If LCase(.Cells(5, y)) Like "*production plan*" Or _ LCase(.Cells(5, y)) Like "*production" & Chr(10) & "plan*" Or _ LCase(.Cells(5, y)) Like "*dispatched volume*" Or _ LCase(Cells(5, y)) Like "*dispatched" & Chr(10) & "volume*" Then .Columns(y).Delete End If Next End With End Sub
    1 point
×
×
  • Create New...

Important Information

Privacy Policy