Jump to content

Antoni

Members
  • Content Count

    10,117
  • Joined

  • Last visited

  • Days Won

    548

Everything posted by Antoni

  1. En un userform, Me.Height controla el alto y Me.Width el ancho. Sin ver el userform es difícil decirte algo más.
  2. ¡Feliz año nuevo a todos! Te dejo el archivo con esta UDF: Public Function SOLO_NUMEROS(Texto As Range) As Variant For x = 1 To Len(Texto) If IsNumeric(Mid(Texto, x, 1)) Then SOLO_NUMEROS = SOLO_NUMEROS & Mid(Texto, x, 1) End If Next End Function DEJAR SOLO NUMEROS.xlsm
  3. ¡ QUE TODO SE REDUCE A QUE EL NOMBRE DEL ARCHIVO CONTIENE CARACTERES INVÁLIDOS (,:+/[email protected]#,......) ! ¿TU TE LEES LAS RESPUESTAS QUE TE DAMOS?
  4. Tu problema está en el nombre del archivo pdf. Hay una serie de caracteres que no pueden usarse en los nombres de archivo Windows, entre ellos están la barra(/) y los dos puntos(:), pero hay muchos más. La barra la he sustituido por un guión(-) y los dos puntos los he eliminado. La macro, una vez limpia y probada, queda así: Sub PdfMail() Dim Archivo As String, Destinatario As String Dim Asunto As String, Cuerpo As String Dim OutlApp As Object, H1 As Worksheet '-- Application.ScreenUpdating = False With Sheets("FICHA") Destinatario = .Range("C11") Asunto = .Range("B72") Cuerpo = .Range("B85") Archivo = Replace(.Range("B70"), "/", "-") Archivo = Replace(Archivo, ":", "") Archivo = ThisWorkbook.Path & "\" & Archivo & ".pdf" .ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=Archivo, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False End With '-- On Error Resume Next Set OutlApp = GetObject(, "Outlook.Application") If Err Then Set OutlApp = CreateObject("Outlook.Application") End If '-- With OutlApp.CreateItem(0) .To = Destinatario .Subject = Asunto .Body = Cuerpo .Attachments.Add Archivo .Display End With '-- Application.ScreenUpdating = True End Sub
  5. ¿Pero tanto cuesta hacer un copiar/pegar?
  6. Como estamos en Navidad 🎅 y no es cuestión de enfadarnos, asigna esta macro a la barra de desplazamiento (Selecciona la barra de desplazamiento\Click derecho\Asignar macro). Sub Barra() Application.ScreenUpdating = False ActiveSheet.Shapes.Range(Application.Caller).Select Select Case Range("A1") Case "BC": Selection.Max = 1000 Case "BCE": Selection.Max = 1350 Case "BV": Selection.Max = 1700 Case "BVE": Selection.Max = 2050 Case "BF": Selection.Max = 2100 Case "BFE": Selection.Max = 2750 End Select ActiveCell.Select End Sub Por cierto, quien te contestó en todoexcel.com, fui yo. 😁
  7. Y además ya te han dado solución aquí: Macro sobre barra de desplazamiento ¿A que viene preguntar lo mismo otra vez?
  8. A la tarde, si puedo, le echo un vistazo más a fondo. A primera vista, todo parece funcionar si tienes la hoja DBDorsales está activada.
  9. Lo que te pasa no tiene nada que ver con que en las celdas haya un valor o una fórmula, ya especificas la propiedad .Value en el momento de comparar, por lo tanto tu problema viene por otro lado. Sube una muestra de tu archivo con el formulario para poder evaluar por donde van los tiros.
  10. Este foro se ha quedado embuclado en el día de la marmota. 😂😂😂
  11. If [B4] = "CANCELACIÓN DE RESERVA" Then [I6] = .Cells(encontrado.Row, "E")
  12. ActiveCell.Formula = "=SUBTOTAL(9," & LE & "3:" & LE & Selection.Row - 1 & ")"
  13. Con fórmulas no se, pero te adjunto una pequeña macro de evento. Haz doble-click en cualquier celda de la columna B (B2 en el ejemplo que has subido) La macro solo actúa si la siguiente fila está vacía. ejemplo (4).xlsm
  14. Casi, casi, lo mismo que JSDJSD: Sub Resumen() Application.ScreenUpdating = False Hoja2.Range("A12:AI" & Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents For x = 10 To Hoja1.Range("A" & Rows.Count).End(xlUp).Row For y = 5 To 11 Set código = Hoja2.Columns("A").Find(Hoja1.Range("A" & x), , xlValues, xlWhole) If Hoja1.Cells(x, y) = 100 Then Set fecha = Hoja2.Rows(10).Find(Hoja1.Cells(8, y), , xlValues, xlWhole) If Not fecha Is Nothing Then If Not código Is Nothing Then fila = código.Row Else fila = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1 Hoja2.Range("A" & fila) = Hoja1.Range("A" & x) Hoja2.Range("B" & fila) = Hoja1.Range("B" & x) Hoja2.Range("C" & fila) = Hoja1.Range("C" & x) Hoja2.Range("D" & fila) = Hoja1.Range("D" & x) End If Hoja2.Cells(fila, fecha.Column) = 100 End If End If Next Next Hoja2.Activate End Sub
  15. Sería una contradicción, si tienes el sistema para protegerte de las macros activado y resulta que puedes anularlo por medio de una macro, no tendría sentido que existiera esa protección. ¿No te parece? Es como si tienes una contraseña y tuvieras un botón para anularla. ¿De que serviría?
  16. Si lo que pretendes hacer es cambiar el CodeName de una hoja: ActiveWorkbook.VBProject.VBComponents(Sheets("Hoja1").CodeName).Name = "NuevaHoja1"
  17. He añadido un control ScrollBar ActiveX (Ficha del programador\Diseño\Insertar) y he añadido la macro siguiente en la hoja. Private Sub ScrollBar1_Change() ActiveSheet.Unprotect Password:="" [A5] = ScrollBar1 Barra ActiveSheet.Protect Password:="" End Sub Barra Scroll (1).xlsm
  18. Tendrás que cambiar la barra de desplazamiento a ActiveX. Sube el archivo y te muestro como.
  19. Con independencia de que la macro se puede enfocar de otra forma, simplemente: For Each celda In Range("E10:Y10") celda.select 'Fila 10 ... celda.Offset(1).Select 'Fila 11 ... celda.Offset(-1).select 'Fila 9 ... Next
  20. Lo mismo que Leopoldo, pero con algo de cosecha propia. Sub DividirTexto_Antoni() Dim PRO As Variant, Texto As Variant Dim Columna As Integer, VAL As Variant Dim Fila As Integer, x As Integer '-- Texto = [C4] Texto = Replace(Texto, "Cantidad", "") Texto = Replace(Texto, "valorUnitario", "") Texto = Replace(Texto, "Importe", "") Texto = Replace(Texto, "Descripción", "") Texto = Replace(Texto, " ", "") Texto = Replace(Texto, "| ", "|") Texto = Replace(Texto, " |", "|") '-- Fila = 5 PRO = Split(Texto, Chr(10)) For x = 0 To UBound(PRO) - 1 VAL = Split(PRO(x), "|") Fila = Fila + 1 For Columna = 1 To 4 Cells(Fila, Columna + 3) = VAL(Columna) Next Next End Sub
  21. ¿Antes de contestar te molestas en leer las respuestas anteriores? porqué a esa conclusión ya se llegó el 24 de noviembre y ya se han dado varias soluciones en ese sentido.
×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png