圆圈里>=10的数字遇到的问题。

ning84

醉眼看尘世 发表于 2024-9-16 15:54
自带的字符集最大带圈字符为20，范围外数字仍需采用你自己的方案
圈的本质是文本框，调整文本框内文字的四 ...

非常感谢，自学就是一点一点的摸索，费时费力效率太低。只有我这个脑袋不清楚的人，到处碰壁，摸索实现目标。


非常感谢你的方法，简单方便实用。



学习了word的符号方法，也没有白学，长知识了。争取以后能用到。

ning84

ning84 发表于 2024-9-16 14:28
非常感谢你帮助。

1. 
   
2. Private Sub SelectRngToSelectText()
   
3.     Dim Ppt As New PowerPoint.Application
   
4.         Set Ppt = New PowerPoint.Application
   
5.     Dim Rng As Range
   
6.         Set Rng = Selection
   
7.     Dim Sht As Worksheet
   
8.         Set Sht = Rng.Parent
   
9.     Dim Pres As Presentation
   
10.     Dim Sld As Slide
    
11.     Dim ShpRng, Shp, Ss As Shape
    
12.    
    
13.    
    
14.         Set ShpRng = Ppt.ActiveWindow.Selection.ShapeRange
    
15.         Debug.Print ShpRng.TextEffect.text
    
16.     Dim Txt As String
    
17.         For ii = 1 To Rng.Rows.Count
    
18.             Select Case Rng(ii, 0)
    
19.                 Case 1 To 10
    
20.                       Txt = Txt & ChrW(CLng("&H" & 2460 + Rng(ii, 0) - 1)) & Rng(ii, 1) '& vbCr
    
21.                 Case 11 To 16
    
22.                       Txt = Txt & ChrW(CLng("&H" & 246 & Chr(65 + Rng(ii, 0) - 11))) & Rng(ii, 1) ' & vbCr
    
23.                 Case 17 To 20
    
24.                       Txt = Txt & ChrW(CLng("&H" & 2470 + Rng(ii, 0) - 17)) & Rng(ii, 1) '& vbCr
    
25.             End Select
    
26.             If ii = Rng.Rows.Count Then
    
27.                  Txt = Txt
    
28.             Else
    
29.                  Txt = Txt & vbCr
    
30.             End If
    
31.             
    
32.             
    
33.         Next ii
    
34.         Debug.Print Txt
    
35.         With ShpRng
    
36.              .TextEffect.text = Trim(Txt)
    
37.              '.TextFrame.AutoSize
    
38.         End With
    
39. End Sub
    

复制代码