文本框--根据文字调整调整形状大小。

ning84

但是采用VBA方法，效果不好。

1. Sub ffff()
   
2.    Dim ShpRng As ShapeRange
   
3.        Set ShpRng = Application.ActiveWindow.Selection.ShapeRange
   
4.        With ShpRng
   
5.             Debug.Print .Name, .TextFrame2.AutoSize
   
6. .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
   
7. End With
   
8.        Stop
   
9. End Sub

复制代码

结果是上下自动调节，左右不能自动调节。





在来一次，手动操作，结果正常。

1. Sub ll()
   
2.    Dim Shp 'As Shape
   
3.       
   
4.        Set Shp = Sheet2.Shapes(1)
   
5.     Dim Rng As Range
   
6.         Set Rng = Selection
   
7.     Dim Txt As String
   
8.         For ii = 1 To Rng.Rows.Count
   
9.             Select Case Rng(ii, 0)
   
10.                 Case 1 To 10
    
11.                       Txt = Txt & ChrW(CLng("&H" & 2460 + Rng(ii, 0) - 1)) & Rng(ii, 1) '& vbCr
    
12.                 Case 11 To 16
    
13.                       Txt = Txt & ChrW(CLng("&H" & 246 & Chr(65 + Rng(ii, 0) - 11))) & Rng(ii, 1) ' & vbCr
    
14.                 Case 17 To 20
    
15.                       Txt = Txt & ChrW(CLng("&H" & 2470 + Rng(ii, 0) - 17)) & Rng(ii, 1) '& vbCr
    
16.             End Select
    
17.             If ii = Rng.Rows.Count Then
    
18.                  Txt = Txt
    
19.             Else
    
20.                  Txt = Txt & vbCr
    
21.             End If
    
22.             
    
23.             
    
24.         Next ii
    
25.         Debug.Print Txt
    
26.         Dim S As Shape
    
27.         With Shp
    
28.              .Select
    
29.              .TextEffect.Text = Trim(Txt)
    
30.              '.TextFrame.AutoSize = True
    
31.              .TextFrame2.AutoSize = msoAutoSizeTextToFitShape
    
32.              '.TextFrame.AutoSize = ppAutoSizeShapeToFitText
    
33.         End With
    
34.       
    
35. End Sub

复制代码

机器太老了，只能office 2007.  严重怀疑是版本问题，出错。