【求助】大家帮忙看看下面的代码，2010版下盖章失效！

xian54966 · 发表于 2012-7-30 22:28

一下代码摘自“【聚宝瓶】自动加盖公章工具”（http://www.excelpx.com/thread-161584-1-1.html），在03版excel下测试成功，刚升级2010版后发现盖出的章变形了（如下图），代码大都一些图形及艺术字的操作，本人刚入门，还请大家帮忙看看！
未命名.jpg

Sub 加盖公章()
Dim txt1 As String
Dim txt2 As String
Dim INSLeft, INSTop As String
Dim rng As Range
On Error Resume Next
txt1 = InputBox("请输入单位名称：", "自动加盖公章", "EP精英培训网")
txt2 = InputBox("请输入公章附文：", "自动加盖公章", "培训部")
Application.ScreenUpdating = False
'删除原来的公章
ActiveSheet.Shapes("公章").Delete
Set rng = Selection
INSLeft = Selection.Left '获得光标的LEFT位置
INSTop = Selection.Top '获得光标的TOP位置
'插入圆
ActiveSheet.Shapes.AddShape(msoShapeOval, INSLeft, INSTop, 112#, 112#).Select
Selection.Name = "圆"
Selection.ShapeRange.Fill.Visible = msoFalse '透明
Selection.ShapeRange.Line.Weight = 3# '加粗
Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0) '红色
'插入单位名称
ActiveSheet.Shapes.AddTextEffect(msoTextEffect3, txt1, "仿宋_GB2312", 36#, msoFalse, msoFalse, INSLeft + 22, INSTop + 18).Select
Selection.Name = "单位名"
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.ShapeRange.Line.Weight = 1.2
Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)
Selection.ShapeRange.Height = 67.75
Selection.ShapeRange.Width = 67.75
Selection.ShapeRange.TextEffect.Tracking = 1.2
Selection.ShapeRange.Adjustments.Item(1) = 210
'插入五角星
ActiveSheet.Shapes.AddShape(msoShape5pointStar, INSLeft + 38, INSTop + 34, 36#, 36#).Select
Selection.Name = "五角星"
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.ShapeRange.Line.Weight = 1.2
Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)
Selection.ShapeRange.Height = 35.45
Selection.ShapeRange.Width = 35.45
'插入公章名称
ActiveSheet.Shapes.AddTextEffect(msoTextEffect1, txt2, "仿宋_GB2312", 36#, msoFalse, msoFalse, INSLeft + 26, INSTop + 73).Select
Selection.Name = "公章名"
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.ShapeRange.Line.Weight = 1.2
Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)
Selection.ShapeRange.Height = 28.35
Selection.ShapeRange.Width = 62.35
'组合图片
ActiveSheet.Shapes.Range(Array("五角星", "单位名", "圆", "公章名")).Select
Selection.ShapeRange.Group.Select
Selection.Name = "公章"
rng.Select
Set rng = Nothing
Application.ScreenUpdating = True
End Sub

复制代码

Select · 发表于 2012-7-30 22:43

本帖最后由 Select 于 2012-7-30 23:09 编辑

如果我碰到这种情况就：先从简单图开始，录制宏，明白后再给自己增加难度 ...
10下运行到这句，就走样了

'所选艺术字中每个字符的水平间隔相对于字符宽度的比例，为稀疏
Selection.ShapeRange.TextEffect.Tracking = 1.2

等学习吧{:261:}

hwc2ycy · 发表于 2012-7-31 06:46

会不会是有参数所代表的意义有变化了。

Select · 发表于 2012-7-31 09:43

对照后发现，下面这句是插入一个艺术字对象（TextEffect），在03和10中效果不同：
ActiveSheet.Shapes.AddTextEffect(msoTextEffect3, txt1, "仿宋_GB2312", 36#, msoFalse, msoFalse, INSLeft + 22, INSTop + 18).Select

03

10

因为还不会把10里的第三个文本效果，改成03里的样子。但至少说明只用AddTextEffect方法，两者有别。
等会技巧了，通过录制宏，也是可学会对应代码的。

xian54966 · 发表于 2012-7-31 11:01

Select 发表于 2012-7-31 09:43
对照后发现，下面这句是插入一个艺术字对象（TextEffect），在03和10中效果不同：
ActiveSheet.Shapes.Add ...

Selection.ShapeRange.TextEffect.PresetShape = msoTextEffectShapeArchUpCurve
Selection.ShapeRange.TextFrame2.WordArtformat = msoTextEffect1

复制代码

添加以上两句可以设置为跟随路径！你试下！

xian54966 · 发表于 2012-7-31 11:05

Select 发表于 2012-7-31 09:43
对照后发现，下面这句是插入一个艺术字对象（TextEffect），在03和10中效果不同：
ActiveSheet.Shapes.Add ...

With Selection.ShapeRange.TextFrame2.TextRange.Font.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With

复制代码

文字填充颜色也有不同！一块学吧！

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

【求助】大家帮忙看看下面的代码，2010版下盖章失效！

相关帖子