Jump to content

Antoni

Members
  • Content Count

    10,577
  • Joined

  • Last visited

  • Days Won

    626

Antoni last won the day on November 27

Antoni had the most liked content!

About Antoni

  • Rank
    Antoni
  • Birthday 04/16/1951

Profile information

  • Gender
    Hombre
  • Localización:
    Galicia (UTC+1)

Converted

  • Campos
    ;
  • Mi versión de Excel:
    0

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. Si lo he entendido: Pega los datos copiados del AS400 en otra parte de la hoja. Con una macro: Concatena las 2 columnas en una de ellas Elimina la otra Copia los datos Pégalos en la tabla.
  2. Sub Eliminar_Filas_1() Dim Filas As Integer Application.ScreenUpdating = False Sheets("Resultados exportados").Select col = "A" texto = Array( _ "QHP Standard 1", _ "QHP Standard 2", _ "QHP Standard 3", _ "QHP Standard 4", _ "QHP Standard 5") Application.ScreenUpdating = False For i = Range(col & Rows.Count).End(xlUp).Row To 1 Step -1 For t = 0 To UBound(texto) If LCase(Cells(i, col)) = LCase(texto(t)) Then Filas = Filas + 1 Rows(i).Delete Exit For End If Next Next Application.ScreenUpd
  3. Basta con añadir una condición más a la macro: Sub Acumular() Application.ScreenUpdating = False ActiveSheet.Copy after:=ActiveSheet For x = Range("E" & Rows.Count).End(xlUp).Row To 3 Step -1 i1 = InStrRev(Range("B" & x), " ") i2 = InStrRev(Range("B" & x - 1), " ") If i1 = 0 Then i1 = Len(Range("B" & x)) If i2 = 0 Then i2 = Len(Range("B" & x - 1)) If Left(Range("B" & x), i1) = Left(Range("B" & x - 1), i2) And _ Range("C" & x) = Range("C" & x - 1) Then '<----- Condición añadida ----------- Range("B" & x - 1) = Left(Range(
  4. Abre el adjunto y pulsa sobre la flecha azul. InformeInstalaciones-24_11_2020.xlsm
  5. Estoy muy liado con temas personales y no dispongo del tiempo necesario para este tema 😒, de momento, te tendrás que conformar con lo que hay. Bo dia dende Bertamiráns. 🙂
  6. Sub Acumular() Application.ScreenUpdating = False Range("A:C").Copy Range("E1") For x = Range("E" & Rows.Count).End(xlUp).Row To 3 Step -1 i1 = InStrRev(Range("E" & x), " ") i2 = InStrRev(Range("E" & x - 1), " ") If i1 = 0 Then i1 = Len(Range("E" & x)) If i2 = 0 Then i2 = Len(Range("E" & x - 1)) If Left(Range("E" & x), i1) = Left(Range("E" & x - 1), i2) Then Range("E" & x - 1) = Left(Range("E" & x - 1), i2) Range("F" & x - 1) = Range("F" & x - 1) + Range("F" & x) Range("E" & x).Resize(1, 3).Delete End If Ne
  7. Tenía esto por ahí, si te interesa, este fin de semana intento estandarizarlo para poder ser usado en varios formularios. Pero un consejo, no te pierdas en adornos que en el fondo solo hacen que complicar las aplicaciones y no sirven para nada o casi para nada y reducen el rendimiento. Y desde el punto de aprendizaje no te aporta nada en absoluto. Redimensionar formulario Plus.xls
  8. Por el mismo precio también va incluido el botón de maximizar. 😂 Y no, no puede aparecer en la barra de tareas, que yo sepa. Minimizar.xlsm
  9. Esta macro crea una copia de la última hoja. Sub CopyLastSheet() Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count) End Sub
  10. Ejecuta la macro Títulos en una hoja vacía: Private Function GetProperties(file As String, propertyVal As Integer) As Variant Dim varfolder, varfile With CreateObject("Shell.Application") Set varfolder = .Namespace(Left(file, InStrRev(file, "\") - 1)) Set varfile = varfolder.ParseName(Right(file, Len(file) - InStrRev(file, "\"))) GetProperties = varfolder.GetDetailsOf(varfile, propertyVal) End With End Function '--------------------------------------------------------------------------------- Sub Títulos() Dim x As Integer For x = 1 To 40 Range("A" & x).Value = GetPropertie
  11. .List(.ListCount -1, 1 ) = ComboProd.List(ComboProd.ListIndex, 1)
  12. Te dejo una función que obtiene la propiedad 27 (Duración) de un archivo. Sub ObtenerDuración() Duración = GetDuration("F:\DSCN0256.AVI") '<---- Ejemplo de llamada End Sub '--------------------------------------------- Function GetDuration(file As String) As Variant With CreateObject("Shell.Application") Set varfolder = .Namespace(Left(file, InStrRev(file, "\") - 1)) Set varfile = varfolder.ParseName(Right(file, Len(file) - InStrRev(file, "\"))) GetDuration = varfolder.GetDetailsOf(varfile, 27) End With End Function Lista de archivos y carpetas.xlsm
  13. La mejor manera de tratar un error es evitar que se produzca, o sea, evitar que el zoom pueda salirse de sus limites (10-400). Te dejo un ejemplo que te sirve para cualquier formulario, solo tienes que copiar el módulo UserformResize y añadir estas líneas en cada formulario: Private Sub UserForm_Initialize() MinZoom = 60: MaxZoom = 125 'Entre 10 y 400 ResizeWindowSettings Me, True End Sub Private Sub UserForm_Resize() UserForm_ResizeZoom Me End Sub Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean) RestoreZoom Me End Sub Nota: Con doble-click en el formulario,
×
×
  • Create New...

Important Information

Privacy Policy