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

ning84 · 发表于 2024-9-16 01:48

判断字号大小结果也不对。

            With .TextFrame2.TextRange
                  .Text = ii
                  If ii <= 9 Then
                        .Font.Size = Ww * 0.6
                  Else
                        .Font.Size = Ww * 0.3
                  End If


            End With

Sub Ll()
Dim Shp As Shape, Shps As Shapes
Set Shps = Sheet1.Shapes
For ii = Shps.Count To 1 Step -1
Set Shp = Shps(ii)
Shp.Delete
Next ii
Dim Ll, Tt, Ww, Hh
Ww = 30
Hh = Ww
Ll = 10
Tt = 30
For ii = 1 To 22
Set Shp = Shps.AddTextbox(msoTextOrientationHorizontal, Ll, Tt, Ww, Hh)
Ll = Ll + Ww * 1
With Shp
.Fill.Visible = msoFalse
'.Line.Visible = msoTrue
.AutoShapeType = msoShapeOval
With .TextFrame2.TextRange
.Text = ii
If ii <= 9 Then
.Font.Size = Ww * 0.6
Else
.Font.Size = Ww * 0.3
End If
End With
.TextEffect.Alignment = msoTextEffectAlignmentWordJustify
With .TextFrame
.VerticalAlignment = xlVAlignCenter
End With
.Line.Visible = msoCTrue
End With
Next ii
End Sub

复制代码

jaxxcyh · 发表于 2024-9-16 09:04

Else .Font.Size = Ww * 0.2

jaxxcyh · 发表于 2024-9-16 09:06

两位数字号大小改成ww*0.2就能完整显示了

ning84 · 发表于 2024-9-16 11:12

怎么在WORD中插入带圈的11至20的序号-百度经验 https://jingyan.baidu.com/article/870c6fc311aee5f13ee4be65.html

打开Word文档之后，在里面输入“246A”，之后将其全部选中（快捷键Ctrl+A），接着用快捷键“Alt+X”，就可以转换了。
d2069ba7b7f1f3f12ea5efc03c2951e9_777f3fc2bbd6e1d0a28e82d60d254193cfe8affd_x-bce-.jpg

d2069ba7b7f1f3f12ea5efc03c2951e9_777f3fc2bbd6e1d0a28e82d60d254193cfe8affd_x-bce-.jpg

测试通过，如何将246A---Alt+X用VBA代码实现。

ning84 · 发表于 2024-9-16 11:52

Selection.InsertSymbol CharacterNumber:=9331, Unicode:=True, Bias:=0
Selection.InsertSymbol CharacterNumber:=9330, Unicode:=True, Bias:=0

⑳⑲

jaxxcyh · 发表于 2024-9-16 11:53

本帖最后由 jaxxcyh 于 2024-9-16 12:14 编辑

ning84 发表于 2024-9-16 11:12
怎么在WORD中插入带圈的11至20的序号-百度经验 https://jingyan.baidu.com/article/870c6fc311aee5f13ee4b ...

Sub test()
Dim mychar As String
mychar = ChrW(&H246A)
[a1].Value = mychar
End Sub

复制代码

jaxxcyh · 发表于 2024-9-16 11:55

以下是一些常见字符的 Unicode 码点：
英文字母：
大写字母 “A” 的 Unicode 码点是 U+0041，十进制为 65。
小写字母 “a” 的 Unicode 码点是 U+0061，十进制为 97。
数字：
“0” 的 Unicode 码点是 U+0030，十进制为 48。
“9” 的 Unicode 码点是 U+0039，十进制为 57。
标点符号：
句号 “。” 的 Unicode 码点是 U+3002，在基本多语言平面内。
逗号 “，” 的 Unicode 码点是 U+FF0C。
问号 “？” 的 Unicode 码点是 U+003F，十进制为 63。
感叹号 “！” 的 Unicode 码点是 U+0021，十进制为 33。
特殊符号：
空格的 Unicode 码点是 U+0020。
星号 “*” 的 Unicode 码点是 U+002A，十进制为 42。
井号 “#” 的 Unicode 码点是 U+0023，十进制为 35。
中文字符：
“中” 字的 Unicode 码点是 U+4E2D，在基本多语言平面内。
“国” 字的 Unicode 码点是 U+56FD。
希腊字母：
小写希腊字母 “α” 的 Unicode 码点是 U+03B1。
大写希腊字母 “Α” 的 Unicode 码点是 U+0391。
表情符号（Emoji）：
😊 的 Unicode 码点是 U+1F60A。
😂 的 Unicode 码点是 U+1F602。

jaxxcyh · 发表于 2024-9-16 13:00

ning84 发表于 2024-9-16 11:12
怎么在WORD中插入带圈的11至20的序号-百度经验 https://jingyan.baidu.com/article/870c6fc311aee5f13ee4b ...

'字符转Unicode码
Function ShowCode(s As String) As String
Dim myCode As String
myCode = Hex(AscW(s))
ShowCode = myCode
End Function
'Unicode码转字符
Function ShowChar(u As String) As String
Dim myChar As String
myChar = ChrW(CLng("&H" & u))
ShowChar = myChar
End Function

复制代码

ning84 · 发表于 2024-9-16 14:28

本帖最后由 ning84 于 2024-9-16 17:42 编辑

jaxxcyh 发表于 2024-9-16 13:00

非常感谢你帮助。

Sub llll()
Dim Rng As Range
Dim Str As String
Set Rng = Selection.CurrentRegion
For ii = 1 To Rng.Rows.Count
Debug.Print ShowChar(Rng(ii, 1))
Str = 2460 + ii - 1
Rng(ii, 3) = ShowChar(Str)
Next ii
End Sub

复制代码

Sub Ll1()
Dim Shp As Shape, TxtEff As TextEffectFormat, Shps As Shapes
Dim ii, jj, kk
Set Shps = Application.ActivePresentation.Slides(1).Shapes
For ii = Shps.Count To 2 Step -1
Set Shp = Shps(ii)
Shp.Delete
Next ii
Dim Ll, Tt, Ww, Hh
Dim Ss, S1, S2, S3, S4
Ss = 22
S1 = 1
S2 = 10
S3 = 16
S4 = 20
''
Ww = 30
Hh = Ww * 0.6
Ll = 10
Tt = 30
For ii = S1 To Ss
Set Shp = Shps.AddTextbox(msoTextOrientationHorizontal, Ll, Tt, Ww, Hh)
Ll = Ll + Ww * 1
With Shp
.Fill.Visible = msoFalse
'.Line.Visible = msoTrue
Select Case ii
Case S1 To S2
.TextEffect.Text = ChrW(CLng("&H" & 2460 + ii - S1))
Case S2 To S3
.TextEffect.Text = ChrW(CLng("&H" & 246 & Chr(65 + ii - S2 - 1)))
Case S3 + 1 To S4
.TextEffect.Text = ChrW(CLng("&H" & 2470 + ii - S3 - 1))
Case Else
.AutoShapeType = msoShapeOval
.TextEffect.Text = ii
.Width = Ww * 1.2
.Height = Hh * 0.9
.Line.Visible = msoCTrue
.TextEffect.FontSize = Hh * 0.6
.TextFrame.AutoSize = ppAutoSizeShapeToFitText
End Select
End With
Next ii
End Sub

复制代码

醉眼看尘世 · 发表于 2024-9-16 15:54

自带的字符集最大带圈字符为20，范围外数字仍需采用你自己的方案
圈的本质是文本框，调整文本框内文字的四边距为0，即可，图码如下

Sub Ll()
Dim Shp As Shape, Shps As Shapes
Set Shps = Sheet1.Shapes
For ii = Shps.Count To 1 Step -1
Set Shp = Shps(ii)
Shp.Delete
Next ii
Dim Ll, Tt, Ww, Hh
Ww = 30
Hh = Ww
Ll = 10
Tt = 30
For ii = 1 To 22
Set Shp = Shps.AddTextbox(msoTextOrientationHorizontal, Ll, Tt, Ww, Hh)
Ll = Ll + Ww * 1
With Shp
.Fill.Visible = msoFalse
.AutoShapeType = msoShapeOval
With .TextFrame2
.MarginLeft = 0
.MarginRight = 0
.MarginTop = 0
.MarginBottom = 0
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorCenter
With .TextRange
.Text = ii
.Font.Size = Ww * 0.6
End With
End With
.TextEffect.Alignment = msoTextEffectAlignmentWordJustify
With .TextFrame
.VerticalAlignment = xlVAlignCenter
End With
.Line.Visible = msoCTrue
End With
Next ii
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

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

评分

评分