vba to change size of a cell's comment box

C

cjcass

Well-known Member
Joined
Oct 27, 2011
Messages
683
Office Version
  1. 2016
Platform
  1. Windows
Hi,
I have the code below that doesn't work correctly. It changes the width of the comment box ok but the height is not correct (too high).
Can any suggest what is wrong with it, or an alternative? I need the box to have a maximum width and the height to adjust accordingly to suit the text in the box.
Many thanks.

VBA Code: 
Dim lArea As Long
With Range("D12").Comment

    .Shape.TextFrame.AutoSize = True

    If .Shape.Width > 400 Then
        lArea = .Shape.Width * .Shape.Height
        .Shape.Width = 400
        .Shape.Height = (lArea / .Shape.Width)
    End If
   
End With
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
The height of the shape depends on the font and font size.
But if you use a letter like "Tahoma" or "Calibri" and a size of 10, you could use the following:

If you use another font or another font size, then change 100, if the font size is less (ex 8), then you increase to 140.

Rich (BB code): 
Sub com2()
  Dim lArea As Long, h As Long, n As Long
  With Range("D12").Comment
    n = WorksheetFunction.RoundUp(Len(.Text) / 100, 0)
    .Shape.TextFrame.AutoSize = True
    h = .Shape.Height
    If .Shape.Width > 400 Then
      .Shape.Width = 400
      .Shape.Height = h * n
    End If
  End With
End Sub
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0
DanteAmor said:
The height of the shape depends on the font and font size.
But if you use a letter like "Tahoma" or "Calibri" and a size of 10, you could use the following:

If you use another font or another font size, then change 100, if the font size is less (ex 8), then you increase to 140.

Rich (BB code): 
Sub com2()
  Dim lArea As Long, h As Long, n As Long
  With Range("D12").Comment
    n = WorksheetFunction.RoundUp(Len(.Text) / 100, 0)
    .Shape.TextFrame.AutoSize = True
    h = .Shape.Height
    If .Shape.Width > 400 Then
      .Shape.Width = 400
      .Shape.Height = h * n
    End If
  End With
End Sub
Click to expand...
Hola estimado.
Está muy bueno, pero tengo un problema que su macro me resuelve mal
Cuando hay saltos de renglon en el comentario.

He intentado algunas pruebas, pero no lo logré.
Si tiene alguna idea, será mas que bienvenida.





Ejemplo de texto en comentario:

El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Comb. C070 @AA1483# ~ Revoque Base Coat Malla Fibra Fibra Viga Columna Pared ~ [ 1m2 = $ 568,56] x 1,8
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Comb. C072 @AA1515# ~ Revoque Grueso e = 0,02 ~ [ 1m2 = $ 279,33] x 1,3
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Comb. C059 @AA1307# ~ Pintura Sintetico Mas Convertidor Ferrobet e = ~ [ 1m2 = $ 494,46] x 1,4
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Simple S016 @M016# ~Albañilería ¦Bloque de cemento 13x19x39 simil piedra (162/pallet) ~ [ Cada Uno = $ 223,69] x 2,2
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Comb. C006 @AA0459# ~ Carpeta e = 0,025 ~ [ 1m2 = $ 397,18] x 1,5
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Simple S046 @M046# ~Barras y Mallas ¦Costo PROMEDIO VARILLA/BARRA {Precio Dolarizado a 1U$S = $ 144,20} ~ [ el kG = $ 296,19] x 3,2
=======================================
Composición del costo de 1m2 : (Formula valorizada)
+(296,19 x 144,20 /144,20 x3,2)+600+(397,18 x1,5)+(223,69 x2,2)+400+(494,46 x1,4)+11+(279,33 x1,3)+(568,56 x1,8) = $ 5.125,48
El valor 144,20 puede responder al tipo de cambio actual (Celda AP5).
El valor 144,20 puede responder al tipo de cambio al momento de obtener el precio
SUBTOTAL DOLARIZADO:$ 74.876,86 depende del ToCo =$ 144,20. Son U$S 519,26
El 18,49% del SUBTOTAL (de Materiales/Col X / $ 404.912,85) ESTÁ DOLARIZADO.
=======================================


Su macro (con cambios)


With Range(cell.Address).Comment
Application.DisplayCommentIndicator = xlCommentIndicatorOnly 'Ocultar_comentario Ocultar comentario
.Visible = True

.Size = 10
.Name = "Tahoma"
n_1 = WorksheetFunction.RoundUp(Len(.Text) / 100, 0)
SaltosInside = Len(.Text) - Len(Replace(.Text, Chr(10), "")) + 1


'En 19.23 de h, entra 1 renglon
.Shape.TextFrame.AutoSize = True

h_1 = .Shape.Height

Stop
If .Shape.Width > 500 Then
.Shape.Width = 500
.Shape.Height = h_1 * n_1 '<< su formula

.Shape.Height = .Shape.Height - (SaltosInside * 19.23) '<< Prueba que no funciona


.Shape.Height = h_1 + (Abs(n_1 - SaltosInside) * 19.23) '<< Prueba que no funciona
.Shape.Height = h_1 + (Abs(SaltosInside + 1) * 19.23) '<< Prueba que no funciona
End If
Stop
If .Shape.Width < 500 Then .Shape.Width = 500: .Shape.Height = .Shape.Height * 2

End With
 
Upvote 0
Hello dear.

It's very good, but I have a problem that your macro solves me wrong

When there are line breaks in the comment.



I have tried some tests but failed.

If you have any ideas, it will be more than welcome.





Ejemplo de texto en comentario:

El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Comb. C070 @AA1483# ~ Revoque Base Coat Malla Fibra Fibra Viga Columna Pared ~ [ 1m2 = $ 568,56] x 1,8
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Comb. C072 @AA1515# ~ Revoque Grueso e = 0,02 ~ [ 1m2 = $ 279,33] x 1,3
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Comb. C059 @AA1307# ~ Pintura Sintetico Mas Convertidor Ferrobet e = ~ [ 1m2 = $ 494,46] x 1,4
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Simple S016 @M016# ~Albañilería ¦Bloque de cemento 13x19x39 simil piedra (162/pallet) ~ [ Cada Uno = $ 223,69] x 2,2
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Comb. C006 @AA0459# ~ Carpeta e = 0,025 ~ [ 1m2 = $ 397,18] x 1,5
El dom, 15 may 2022 20:01 >ADMIN< con Costo Materiales del 28/ago/22 ingresó Mat. Simple S046 @M046# ~Barras y Mallas ¦Costo PROMEDIO VARILLA/BARRA {Precio Dolarizado a 1U$S = $ 144,20} ~ [ el kG = $ 296,19] x 3,2
=======================================
Composición del costo de 1m2 : (Formula valorizada)
+(296,19 x 144,20 /144,20 x3,2)+600+(397,18 x1,5)+(223,69 x2,2)+400+(494,46 x1,4)+11+(279,33 x1,3)+(568,56 x1,8) = $ 5.125,48
El valor 144,20 puede responder al tipo de cambio actual (Celda AP5).
El valor 144,20 puede responder al tipo de cambio al momento de obtener el precio
SUBTOTAL DOLARIZADO:$ 74.876,86 depende del ToCo =$ 144,20. Son U$S 519,26
El 18,49% del SUBTOTAL (de Materiales/Col X / $ 404.912,85) ESTÁ DOLARIZADO.
=======================================


Your macro (with changes):

VBA Code: 
                     With Range(cell.Address).Comment
                                    Application.DisplayCommentIndicator = xlCommentIndicatorOnly 'Ocultar_comentario Ocultar comentario
                                    .Visible = True
                                 
                                    .Size = 10
                                    .Name = "Tahoma"
                                    n_1 = WorksheetFunction.RoundUp(Len(.Text) / 100, 0)
                                    SaltosInside = Len(.Text) - Len(Replace(.Text, Chr(10), "")) + 1
                                 
                                 
                                    'in 19.23 of h, enter one  line
                                    .Shape.TextFrame.AutoSize = True

                                    h_1 = .Shape.Height

                                    Stop
                                    If .Shape.Width > 500 Then
                                                                    .Shape.Width = 500
                                                                    .Shape.Height = h_1 * n_1   '<< your code
                                                                 
                                                                    .Shape.Height = .Shape.Height - (SaltosInside * 19.23)  '<< Prueba que no funciona
                                                                 
                                                                 
                                                                    .Shape.Height = h_1 + (Abs(n_1 - SaltosInside) * 19.23) '<< test code not working
                                                                    .Shape.Height = h_1 + (Abs(SaltosInside + 1) * 19.23)  '<< test code not working
                                                          End If
                                    Stop
                                    If .Shape.Width < 500 Then .Shape.Width = 500: .Shape.Height = .Shape.Height * 2
                                 
                                    End With
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Resize comment VBA
Replies
2
Views
667
rollis13
rollis13
D
  • Solved
Vba comments
Replies
6
Views
490
doriannjeshi
D
Q
  • Solved
VBA: Dynamically Create Active X Frame and Yes / No Radio Button
2
Replies
13
Views
176
Domenic
D
E
  • Solved
Subroutine to Add Cell Comments Not Updating the Contents Correctly
Replies
7
Views
639
CephasOz
CephasOz
C
  • Question Question
PLEASE HELP VBA - SO LONG NEEDS CONDENSING AND OPTIMIZATION
Replies
4
Views
373
davesexcel
davesexcel

Forum statistics

Threads
1,223,893
Messages
6,175,248
Members
452,623
Latest member
cliftonhandyman

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top