电子印章（宏）最终体验版 v5.24

loquat · 发表于 2015-8-10 14:37

本帖最后由 loquat 于 2015-8-10 14:38 编辑

If j = 5 Then: s = 2.4: t = 4.9: r = 243
ElseIf j = 6 Then s = 1.98: t = 3.9: r = 247
ElseIf j = 7 Then s = 1.7: t = 3.5: r = 251
ElseIf j = 8 Then s = 1.48: t = 3.1: r = 252
ElseIf j = 9 Then s = 1.33: t = 2.8: r = 255
ElseIf j = 10 Then s = 1.19: t = 2.5: r = 257
ElseIf j = 11 Then s = 1.08: t = 2.3: r = 258.5
ElseIf j = 12 Then s = 1: t = 2: r = 260.5
ElseIf j = 13 Then s = 0.92: t = 1.8: r = 262
ElseIf j = 14 Then s = 0.86: t = 1.7: r = 264
ElseIf j = 15 Then s = 0.8: t = 1.6: r = 264.5
ElseIf j = 16 Then s = 0.75: t = 1.5: r = 265.5
ElseIf j = 17 Then s = 0.7: t = 1.4: r = 266.5
ElseIf j = 18 Then s = 0.67: t = 1.3: r = 267
ElseIf j = 19 Then s = 0.63: t = 1.32: r = 268
ElseIf j = 20 Then s = 0.6: t = 1.27: r = 269
ElseIf j = 21 Then s = 0.57: t = 1.2: r = 269
ElseIf j = 22 Then s = 0.55: t = 1.1: r = 269
ElseIf j = 23 Then s = 0.52: t = 1.1: r = 269
ElseIf j = 24 Then s = 0.5: t = 1.05: r = 269
ElseIf j = 25 Then s = 0.48: t = 1: r = 269.5
ElseIf j = 26 Then s = 0.46: t = 0.97: r = 269.5
ElseIf j = 27 Then s = 0.45: t = 0.93: r = 269.5
ElseIf j = 28 Then s = 0.43: t = 0.88: r = 269.5
ElseIf j = 29 Then s = 0.41: t = 0.85: r = 269.9
ElseIf j = 30 Then s = 0.4: t = 0.8: r = 269.9
ElseIf j = 4 Then s = 3: t = 5: r = 235
ElseIf j = 3 Then s = 3.9: t = 5: r = 220
End If

复制代码

可以再简化成这样

s = Array(2.4, 1.98, 1.7, 1.48, 1.33, 1.19, 1.08, 1, 0.92, 0.86, 0.8, 0.75, 0.7, 0.67, 0.63, 0.6, 0.57, 0.55, 0.52, 0.5, 0.48, 0.46, 0.45, 0.43, 0.41, 0.4, 3, 3.9)
t = Array(4.9, 3.9, 3.5, 3.1, 2.8, 2.5, 2.3, 2, 1.8, 1.7, 1.6, 1.5, 1.4, 1.3, 1.32, 1.27, 1.2, 1.1, 1.1, 1.05, 1, 0.97, 0.93, 0.88, 0.85, 0.8, 5, 5)
r = Array(243, 247, 251, 252, 255, 257, 258.5, 260.5, 262, 264, 264.5, 265.5, 266.5, 267, 268, 269, 269, 269, 269, 269, 269.5, 269.5, 269.5, 269.5, 269.9, 269.9, 235, 220)
j = len(i)
'调用时：若Option Base 0，则调用s(j-5)
' 若Option Base 1，则调用s(j-4)
'可以节省大量篇幅，但是效率估计有所降低，其实也可以使用三维数组arr(1 to 3, 1 to 26) as single '这里使用double没有意义，且影响效率

复制代码

loquat · 发表于 2015-8-10 14:52

本帖最后由 loquat 于 2015-8-11 23:16 编辑

修正错误

Sub 电子印章_v5_23()
'(c) by 413191246se
'(e) by loquat
Application.ScreenUpdating = False
If Documents.count = 0 Then Documents.Add
Dim i$, s, t, r, arr(1 To 4) As String, x!, f$, a$
InputMark:
i = InputBox("请注意！印章正文（3-30字）和附言（2-6字）可以一起输入，但必须以中文逗号，分隔！", "电子印章", "辽宁省朝阳市通用模板公司，业务专用章")
If i = "" Then Exit Sub
a = InStrRev(i, "，")
If a Then f = Mid(i, a + 1): i = Left(i, a - 1) Else f = "财务专用章"
If Len(i) < 3 Or Len(i) > 30 Or Len(f) < 2 Or Len(f) > 6 Then GoTo InputMark
If Len(f) = 5 Then
x = 258.4!
ElseIf Len(f) = 4 Then x = 264.5!
ElseIf Len(f) = 3 Then x = 263.5!: f = Left(f, 1) & " " & Mid(f, 2, 1) & " " & Right(f, 1)
ElseIf Len(f) = 2 Then x = 270.5!: f = Left(f, 1) & " " & Right(f, 1)
ElseIf Len(f) = 6 Then x = 251.5!
End If
s = Array(2.4!, 1.98!, 1.7!, 1.48!, 1.33!, 1.19!, 1.08!, 1!, 0.92!, 0.86!, 0.8!, 0.75!, 0.7!, 0.67!, 0.63!, 0.6!, 0.57!, 0.55!, 0.52!, 0.5!, 0.48!, 0.46!, 0.45!, 0.43!, 0.41!, 0.4!, 3!, 3.9!)
t = Array(4.9!, 3.9!, 3.5!, 3.1!, 2.8!, 2.5!, 2.3!, 2!, 1.8!, 1.7!, 1.6!, 1.5!, 1.4!, 1.3!, 1.32!, 1.27!, 1.2!, 1.1!, 1.1!, 1.05!, 1!, 0.97!, 0.93!, 0.88!, 0.85!, 0.8!, 5!, 5!)
r = Array(243!, 247!, 251!, 252!, 255!, 257!, 258.5!, 260.5!, 262!, 264!, 264.5!, 265.5!, 266.5!, 267!, 268!, 269!, 269!, 269!, 269!, 269!, 269.5!, 269.5!, 269.5!, 269.5!, 269.9!, 269.9!, 235!, 220!)
With ActiveDocument.Shapes
With .AddTextEffect(msoTextEffect3, i, "宋体", 12!, msoFalse, msoFalse, 219.75!, 103!) '艺术字
.TextEffect.Tracking = t(Len(i) - 5)
.ScaleHeight 12, msoFalse, msoScaleFromTopLeft
.ScaleWidth s(Len(i) - 5), msoFalse, msoScaleFromTopLeft
.Adjustments(1) = r(Len(i) - 5)
arr(1) = .Name
End With
With .AddShape(msoShapeOval, 201.6!, 85!, 180!, 180!) '圆周
.Fill.Transparency = 1!
.Line.Style = msoLineThickThin
arr(2) = .Name
End With
arr(3) = .AddShape(msoShape5pointStar, 264!, 147.8!, 54.9!, 47.6).Name '五角星
With .AddTextEffect(msoTextEffect3, f, "宋体", 13!, msoTrue, msoFalse, x, 206!) '附言
.TextEffect.PresetShape = msoTextEffectShapePlainText
.Fill.Visible = msoTrue
arr(4) = .Name
End With
With .Range(Array(arr(1), arr(2), arr(3), arr(4))).Group '组合
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.Weight = 0.25!
.GroupItems(2).Line.Weight = 3.5
.LockAspectRatio = msoTrue
.ScaleWidth 0.6, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.6, msoFalse, msoScaleFromTopLeft
.IncrementTop 92.6!
.IncrementLeft 119.4!
.Select
End With
End With
Application.ScreenUpdating = True
End Sub

复制代码

413191246se · 发表于 2015-8-10 21:04

本帖最后由 413191246se 于 2015-8-10 21:07 编辑

谢谢 loquat ！数组/函数我是真的一点也不懂！连 InStr 函数都不会用，还是跟你学的呢！最近两天一直忙徒弟 139 的问题，重新改写了两个功能，也是煞费苦心，没办法，水平太低，但求人也不易，还是得自己想办法。（其实我做我的通用模板，也不必用窗体，只是处理段落和文字，好办不少，但 139 的问题只好用窗体/控件了，我又不熟，查各个控件的使用方法费了不少时间，但界面还是得依靠核心代码来支撑。）

loquat · 发表于 2015-8-11 12:09

@413191246se
兄过谦了，我也只是入门新手。并且现在也没太多时间研究VBA了。

413191246se · 发表于 2015-8-11 12:14

——loquat: 刚才我测试了一下，发现错误百出，是数组的问题，还得劳你费心一下，测试 OK 再放上来，数组/函数我是一点也不懂，谢谢！

413191246se · 发表于 2015-8-12 15:06

顶以更新！！！

tangqingfu · 发表于 2015-8-12 15:25

谢谢413191246se兄和loquat兄，能否加入调节开头大小的inputbox，给个默认值，（提醒）用户根据需求输入数值（开口大小）？

loquat · 发表于 2015-8-12 20:48

报告楼主，4句 .Line.Weight还可以简写为2句。
可以参考楼上代码

413191246se · 发表于 2015-8-12 22:08

3Q 两位，Please Waitting......

413191246se · 发表于 2015-8-14 07:36

loquat:
请问：数组中 s = Array(2.4!, 1.98!, 1.7! 里面的"!"英文感叹号，表示数据类型为 Single，但我看网上介绍数组函数 Array 的例子中，都不加"!"感叹号啊！加了增加了字节数，不符合节约原则，加/不加有什么区别吗？（你的回复由于未在最末帖子，所以，11号那天我没看到你的回复。后来我反复查找网上数组帮助，完成了与你类似的一维数组的写法。）

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

[分享] 电子印章（宏）最终体验版 v5.24

之前未测试，现在修改发上来。。。