Pasar a negrita textos específicos en un contrato en Excel usando VBA
Tengo un contrato hecho en excel, que me pone en negrita los textos que yo le indique en una columna, el inconveniente es que cuando hago correr la macro, también pone en negrita toda coincidencia que encuentre en la columna L, ejemplo si hago un descuento al 3%, me pone en negrita el 3% y si mi fecha es el 3 de abril, también me coloca, lo que quiero es ver si la macro se puede ajustar para colocar en negrita solo lo especificado por favor y que me copie en una hoja solo el cuerpo del contrato y no también todo lo que se encuentre en la hoja auxiliar.
1 Respuesta
¿Cómo tienes la fórmula en la columna A para poner el porcentaje?
Prueba la siguiente actualización:
Sub PonerNegritas()
'Por Dante Amor
Dim sh1 As Worksheet, sh2 As Worksheet
Dim c As Range, rng As Range, celda As Range
Dim arr As Variant
Dim dato As String
Dim lr As Long, j As Long, ini As Long, n As Long
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'
'Copia la Hoja1 en la hoja Contrato para tener solamente valores
Set sh1 = Sheets("Hoja1")
On Error Resume Next
Sheets("Contrato").Delete
On Error GoTo 0
sh1.Copy after:=Sheets(Sheets.Count)
Set sh2 = ActiveSheet
sh2.Name = "Contrato"
'
lr = sh2.Range("A" & Rows.Count).End(3).Row
With sh2.Range("A1:J" & lr)
.Value = .Value
End With
'
'En la siguiente línea debes poner las celdas que quieres en negritas
'Puedes poner celdas individuales o un rango:
Set rng = sh2.Range("L2, L3, L9, L10, L13, L14, L16, L18, L19, L21, L22, L24:L29")
'
'Pone los textos en negritas
For Each c In sh2.Range("A1:A" & lr)
ini = 0
n = 0
If c.Value <> "" Then
For Each celda In rng
dato = celda.Value
Select Case True
Case celda.Address(0, 0) = "L13" Or celda.Address(0, 0) = "L16"
dato = Trim(celda.Text)
Case celda.Address(0, 0) = "L19" Or celda.Address(0, 0) = "L21"
dato = Format(celda.Value, "dd/mm/yyyy")
Case celda.Address(0, 0) = "L14"
dato = Format(celda.Value, "##%")
End Select
For j = 1 To Len(c.Value)
If Mid(c.Value, j, Len(dato)) = dato Then
c.Characters(Start:=j, Length:=Len(dato)).Font.Bold = True
End If
If Mid(c.Value, j, 1) = "(" Then
ini = j
n = 1
End If
If n > 0 Then n = n + 1
If Mid(c.Value, j, 1) = ")" And ini > 0 Then
c.Characters(Start:=ini, Length:=n).Font.Bold = True
End If
Next
Next
End If
Next
sh2.Range("K:Z").Clear
'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Actualizado Dante, colocó en negrita "SET" y este no debe ir en negrita y en las firmas al pie del contrato dejó sin datos pero en la hoja auxiliar están los datos de los firmates =(...
También veo que cuando coincide los datos de la columna L, ejemplo la dirección es Super carreta km 32 este si corresponde que pase a negrita, pero justo mi fecha o numero de factura tiene un 2 entre ellos, también lo resalta en negrita, no se si se puede filtrar, porque la macro compara y si entre ellos hay un dato lo pasa a negrita
Son varios detalles.
Cada uno se debe tratar individualmente.
Te explico con un ejemplo sencillo.
Si quieres que la letra "A" se ponga en negrita. La macro va a poner todas la letras "A" que encuentre en negrita.
Pero si quieres que solamente una letra "A" vaya en negrita se debe especificar algún patrón para identifica la letra "A" que va en negritas.
Lo que te quiero decir, es que no te desesperes.
Tienes que decirme cuál es el patrón para cada caso y se debe adecuar la macro para cada caso.
La complejidad es porque en la columna L tienes fórmulas y formatos.
Si en la columna L pones el texto sin formato, sin fórmulas, entonces la macro actuará de mejor manera.
A qué me refiero con formato.
En la celda L14 tienes el número 3
Pero con formato visualmente se ve como 3%
Pero realmente sólo tienes el número 3.
En los textos tienes 3%, pero la macro solamente está buscando el número 3.
Entonces si ajustas todos los datos de la columna L en textos sin formatos, la macro lo identificará.
Nuevamente regresando al ejemplo. En la celda L14, debes cambiar el formato de la celda a texto. Y capturar textualmente el 3%, entonces realmente ves un 3% y tienes 3% en la celda.
Si haces lo explicado entonces, prueba la versión anterior de la macro.
Lo mismo debes hacer con los importes.
Tienes varios errores en tus formatos.
En la columna L en la hoja1, en el formato fecha debe ser "dd/mm/yyyy"
Para L4, L19, L21.
Este es el nuevo código:
Sub PonerNegritas()
'Por Dante Amor
Dim sh1 As Worksheet, sh2 As Worksheet
Dim c As Range, rng As Range, celda As Range
Dim arr As Variant
Dim dato As String
Dim i As Long, lr As Long, j As Long, ini As Long, n As Long
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'
'Copia la Hoja1 en la hoja Contrato para tener solamente valores
Set sh1 = Sheets("Hoja1")
On Error Resume Next
Sheets("Contrato").Delete
On Error GoTo 0
sh1.Copy after:=Sheets(Sheets.Count)
Set sh2 = ActiveSheet
sh2.Name = "Contrato"
'
lr = sh2.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
With sh2.Range("A1:Z" & lr)
.Value = .Value
End With
sh2.Range("M:M").NumberFormat = "@"
For i = 1 To sh2.Range("L" & Rows.Count).End(3).Row
sh2.Range("M" & i).Value = Trim(sh2.Range("L" & i).Text)
Next
Sh2.Range("M:M"). Copy sh2. Range("L1")
'
'En la siguiente línea debes poner las celdas que quieres en negritas
'Puedes poner celdas individuales o un rango:
Set rng = sh2.Range("L2, L3, L9, L10, L13, L14, L16, L18, L19, L21, L22, L24:L29")
'
'Pone los textos en negritas
For Each c In sh2.Range("A1:A" & lr)
ini = 0
n = 0
If c.Value <> "" Then
For Each celda In rng
dato = celda.Value
For j = 1 To Len(c.Value)
If Mid(c.Value, j, Len(dato)) = dato Then
c.Characters(Start:=j, Length:=Len(dato)).Font.Bold = True
End If
If Mid(c.Value, j, 1) = "(" Then
ini = j
n = 1
End If
If n > 0 Then n = n + 1
If Mid(c.Value, j, 1) = ")" And ini > 0 Then
c.Characters(Start:=ini, Length:=n).Font.Bold = True
End If
Next
Next
End If
Next
sh2.Range("K:Z").Clear
'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Excelente Dante, un ultimo detalle, no sabrías porque pasa en negrita este Texto "SET", este no debería ir en negrita, si me podrías ayudar por fa,
Es porque está entre paréntesis. Las textos de los importes están entre paréntesis, entonces supuse que todo lo que está entre paréntesis es un importe y debe ir en negritas.
Si no es así, entonces borra estas líneas de la macro:
If Mid(c.Value, j, 1) = "(" Then
ini = j
n = 1
End If
If n > 0 Then n = n + 1
If Mid(c.Value, j, 1) = ")" And ini > 0 Then
c.Characters(Start:=ini, Length:=n).Font.Bold = True
End IfY los textos de los importes los debes poner en la columna L. Y agrega la celda en la macro.
Entiendo Dante, y se puede hacer tipo que si hay "Gs. Monto en valor ahí convierta en negrita para evitar colocar el importe en la columna L, ya que la condicionante será que si antes del paréntesis haya valor numérico y también la sigla "GS". lo convierta en negrita y si no se cumple esa condición que no lo convierta, solo si se puede,
Saludos
