Excelのコメントを自動サイズ調整する方法は？

Question

コメントのポップアップをExcelセルでの自動サイズにする方法を見つけようとしています。 AutoSizeプロパティを使用するだけでは、コメントがの単一行に変換されるため、受け入れられません。ここに私の考えがあります：

• AutoSizeをtrueに設定します。
• コメントの寸法を という単一行で計算します。
• 1行コメントの領域を3x4のアスペクト比に調整することで、新しい次元を計算することができます。

このアプローチの問題は、長いコメント、および改行で、特にコメントに、これは下で空白を残していることです。

はへの道はコメント高さはありませんので（あるいは、少なくとも、あまりない）空白があるを調整しないありますか？コメントの最後の文字が表示されているかどうかを検出し、サイズを調整しない場合は？あるいは何か他のものを使う？

試行錯誤では、テキストの量（正確には、単一行の自動サイズのコメントの長さや面積）に基づいてコメントの高さをどれだけ調整できるかによってかなり分かりました。短いコメントの場合は約0.7、長いフォントの場合は0.52（デフォルトフォント/ etcを使用）です。しかし、の改行をに投げると、さらに複雑になります（タイトル改行を数えずに、改行ごとにテキストの約25％を占めると考えました）。私はそれをより正確で壊れにくくしたい（別のフォントのために壊れた場合など）。

もっと良い方法があれば教えてください。 （長いコメントのために）1行でなく、不必要な空白を多く残さず、コメントテキストが切り取られない限り、私は任意のアイデアを公開しています（テキストが切り取られるかどうかは気にしませんExcelスプレッドシートの境界線による権利）。

Sub AutoSizeCommentInSelectedCellTest() 
    Dim cellComment As Comment ' selected cell 
    Dim area As Double   ' comment rectangle area 

    Const MAX_COMMENT_WIDTH = 300 

    ' Make sure we have a seected cell. 
    If ActiveCell Is Nothing Then 
     Exit Sub 
    End If 

    ' Make sure we have a comment in the selected cell. 
    Set cellComment = ActiveCell.Comment 

    If cellComment Is Nothing Then 
     Exit Sub 
    End If 

    With cellComment 
     With .Shape 
      ' AutoSize will covert comment to a single line. 
      .TextFrame.AutoSize = True 

      ' If comment's width is shorter than max, we're done. 
      If .width < MAX_COMMENT_WIDTH Then 
       Exit Sub 
      End If 

      ' Calculate area of the comment text rectangle 
      ' for a single-line comment. 
      area = .width * .height 

      ' Make new comment area roughly 4h x 3w. 
      .width = (VBA.Sqr(area/12)) * 3 
      .height = (VBA.Sqr(area/12)) * 4 

      ' Now, for longer comments, and especially comments 
      ' with line break, this leaves a lot of white space 
      ' at the bottom. How do we fix it? 
     End With 
    End With 
End Sub 

Answer 1

あなたのコードは、いくつかの間違いがあります。

は、ここに私のマクロです。 .Shapeが欠けている。

Sub AutoSizeCommentInSelectedCell() 
    Dim cellComment As Comment ' selected cell 
    Dim area As Double   ' comment rectangle area 
    Dim n As Integer, vS As Variant 
    Dim myMax As Integer, base As Single, rowLen As Integer 
    Dim Wf As WorksheetFunction 
    Dim vR(), rowCnt As Integer, myHeight As Single 

    Set Wf = WorksheetFunction 

    Const MAX_COMMENT_WIDTH = 300 

    ' Make sure we have a seected cell. 
    If ActiveCell Is Nothing Then 
     Exit Sub 
    End If 

    ' Make sure we have a comment in the selected cell. 
    Set cellComment = ActiveCell.Comment 

    If cellComment Is Nothing Then 
     Exit Sub 
    End If 

    With cellComment 
     'myLen = Len(.Text) 

     vS = Split(.Text, Chr(10)) 
     ReDim vR(UBound(vS)) 
     For i = 0 To UBound(vS) 
      vR(i) = Len(vS(i)) 
     Next i 
     myMax = Wf.Max(vR) 
     n = UBound(vS) 
     ' AutoSize will covert comment to a single line. 
     .Shape.TextFrame.AutoSize = True 

     ' If comment's width is shorter than max, we're done. 
     With .Shape 
      base = .Height/(n + 1) 
      rowLen = Wf.RoundDown(myMax * (300/.Width), 0) 'row character's length when width 300 
      rowLen = rowLen - rowLen * 0.1 '<~~line character's number is more small. 
      For i = 0 To n 
       If Len(vS(i)) = 0 Then 
        rowCnt = rowCnt + 1 
       Else 
        rowCnt = rowCnt + Wf.RoundUp(Len(vS(i))/rowLen, 0) 
       End If 
      Next i 
      myHeight = rowCnt * base 

      If .Width < MAX_COMMENT_WIDTH Then 
       Exit Sub 
      End If 
      .Width = 300 
      .Height = myHeight 
     End With 
    End With 
End Sub