Anónimo
Anexar texto al final de contenido de una celda con macro
Tengo una columna B que contiene nombres de documentos a la cual necesito agregarle al final de dicho texto la terminación ".pdf" que evalué si ya tiene el texto dicha terminación no lo coloque y pase a la siguiente fila en la columna B
Buscando encontré esta macro pero anexa los caracteres o texto después de la primera letra y necesito que se agregue al final al igual que evalué si mi texto ya tiene la terminación .pdf
Sub InsertaCaracter()
Do
texto = ActiveCell.Value
Cadena = ""
i = 1
Cadena = Mid(texto, i, 1) & ".pdf" & Mid(texto, i + 1, Len(texto) - 1)
ActiveCell.Value = Cadena
ActiveCell.Offset(1).Select
Loop Until IsEmpty(ActiveCell)
End Sub
ejemplo
antes después
PII-CPI-SG-SST-1-2015 PII-CPI-SG-SST-1-2015.pdf
DGTRI-DP-JA-CP-SG-SPRO-001-2015 DGTRI-DP-JA-CP-SG-SPRO-001-2015.pdf
PPQ-CPI-SG-SM-146-2015 PPQ-CPI-SG-SM-146-2015.pdf
DGTRI-DP-JA-CPI-SG-SST-DIP-3-2015.pdf DGTRI-DP-JA-CPI-SG-SST-DIP-3-2015.pdf
De antemano muchas gracias :3 lindo dia
2 Respuestas
Valida primero si la celda ya termina con la extensión que buscas .pdf usando la siguiente fórmula
Public Function EndsWith(str As String, ending As String) As Boolean
Dim endingLen As Integer
endingLen = Len(ending)
EndsWith = (Right(Trim(UCase(str)), endingLen) = UCase(ending))
End Functionsi regresa false entonces simplemente se lo agregas y listo
Cadena = texto & ".pdf"
ActiveCell.Value = Cadena
disculpe de favor me podría ayudar a adecuarlo la verdad apenas estoy empezando a investigar y tratar de entender como funciona esto de la programación de macros gracias
'Quedaría de la siguiente forma:
Sub InsertaExtension()
Do
Dim texto As String
texto = ActiveCell.Value
cadena = ""
i = 1
If EndsWith(texto, ".pdf") = False Then
cadena = texto & ".pdf"
Else
cadena = texto
End If
ActiveCell.Value = cadena
ActiveCell.Offset(1).Select
Loop Until IsEmpty(ActiveCell)
End Sub
Public Function EndsWith(str As String, ending As String) As Boolean
Dim endingLen As Integer
endingLen = Len(ending)
EndsWith = (Right(Trim(UCase(str)), endingLen) = UCase(ending))
End Function
'Notas:
'Utilice tu mismo método, solo agregue una declaración de la variable texto a tipo String y agregue el if.else para validar si la celda activa ya estaba con su extensión
'algo muy importante para que funcione tu método tienes que posicionar/seleccionar la primer celda del rango a cambiar de lo contrario comenzara desde la celda que tengas seleccionada.
Utiliza mejor el método de Dante Amor, te lo paso con anotaciones si se te hace más fácil
Sub AgrgarPdfExtension()
'Cambiar el num 1 del ciclo for por donde comience tu lista, si comienza desde la primer, segunda fila etc.
'cambiar letra de la columna donde esten tus valores
Dim letra As String
letra = "A"
For i = 1 To Range(letra & Rows.Count).End(xlUp).Row
If UCase(Right(Cells(i, letra), 4)) <> ".PDF" Then
Cells(i, letra) = Cells(i, letra) & ".pdf"
End If
Next
End Sub
