WPS表格中插入艺术字时,第二次不能正确处理问题

xwdys

以下代码在Excel模块中可以正确运行,但在WPS表格中第二次不能正确处理。请教怎么处理？

1. Sub test()
   
2.     ArtWord "shapeName1", "hello"
   
3.     ArtWord "shapeName1", "World"  ' 第二次调用不处理
   
4. End Sub
   
5. 
   
6. Sub ArtWord(shapeName$, txt$)
   
7.     Dim newArtWord As Variant
   
8. 
   
9.     On Error Resume Next
   
10.     Sheet1.Shapes(shapeName).Select
    
11.     If Err.Number = 0 Then
    
12.         Sheet1.Shapes(shapeName).TextEffect.Text = txt  '==== 这里不显示艺术字 World ====
    
13.     Else
    
14.         Set newArtWord = Sheet1.Shapes.AddTextEffect(msoTextEffect1, txt, "黑体", 24, msoFalse, msoFalse, 40, 100)
    
15.         newArtWord.Name = shapeName
    
16.     End If
    
17.     Application.ScreenUpdating = True
    
18.     MsgBox "pause..."
    
19. End Sub

复制代码

xwdys

应该是.Text属性没起作用

一步001

Sub test()  
    ArtWord "shapeName1", "hello"  
    ArtWord "shapeName1", "World"  ' 第二次调用现在应正确处理  
End Sub  
  
Sub ArtWord(shapeName As String, txt As String)  
    Dim newArtWord As Shape  
    Dim ws As Worksheet  
    Set ws = ThisWorkbook.Sheets("Sheet1")  ' 确保指定正确的工作表  
  
    On Error Resume Next  ' 忽略接下来的错误  
    ws.Shapes(shapeName).Select  
    If Err.Number = 0 Then  
        ws.Shapes(shapeName).TextFrame.TextRange.Text = txt  ' 使用正确的属性来设置文本  
    Else  
        Err.Clear  ' 清除之前的错误  
        On Error GoTo 0  ' 重置错误处理  
        Set newArtWord = ws.Shapes.AddTextEffect(msoTextEffect1, txt, "黑体", 24, msoFalse, msoFalse, 40, 100)  
        newArtWord.Name = shapeName  
    End If  
    Application.ScreenUpdating = True  
    MsgBox "pause..."  
End Sub

xwdys

一步001 发表于 2024-4-8 15:01
Sub test()  
    ArtWord "shapeName1", "hello"  
    ArtWord "shapeName1", "World"  ' 第二次调用现 ...

感谢回复。但仍然没反应。是不是表格版本问题？
版本为WPS表格 12.1.0.16417

一步001

xwdys 发表于 2024-4-8 19:33
感谢回复。但仍然没反应。是不是表格版本问题？
版本为WPS表格 12.1.0.16417

我的是统信（uos）系统，wps表格11.8，不能运行vba,所以没办法帮你测试，不好意思

xwdys

一步001 发表于 2024-4-10 16:13
我的是统信（uos）系统，wps表格11.8，不能运行vba,所以没办法帮你测试，不好意思

谢谢 一步001 ！
改成jsa也没反应，代码有问题吗？刚又升级到WPS 表格(12.1.0.16729) WPS 365云办公服务的一部分

1. 
   
2. function test() {
   
3.     ArtWord("shapeName1", "hello");
   
4.     ArtWord("shapeName1", "World");
   
5. }
   
6. 
   
7. function ArtWord(shapeName, txt) {
   
8.     var newArtWord;
   
9.     var sht1=Worksheets("Sheet1");
   
10. 
    
11.     try {
    
12.         sht1.Shapes(shapeName).TextEffect.Text = txt;  //==== .Text属性问题 ====
    
13.         MsgBox(txt);
    
14.     } catch (error) {
    
15.         newArtWord = sht1.Shapes.AddTextEffect(msoTextEffect1, "abc", "黑体", 24, msoFalse, msoFalse, 40, 100);
    
16.         newArtWord.Name = shapeName;
    
17.     };
    
18.     Application.ScreenUpdating = true;
    
19.     alert("pause...");
    
20. }
    

复制代码

一步001

1. 
   
2. function test() {
   
3.         let n=0;//增加艺术字垂直方向上的距离
   
4.     ArtWord("shapeName1", "hello",n);
   
5.     n++;
   
6.     ArtWord("shapeName1", "World",n);
   
7. }
   
8. 
   
9. function ArtWord(shapeName, txt,n) {
   
10.     var newArtWord;
    
11.     var sht1=Worksheets("Sheet1");
    
12.     newArtWord = sht1.Shapes.AddTextEffect(msoTextEffect1, txt, "黑体", 24, msoFalse, msoFalse, 40, 50*(n+1));
    
13.     newArtWord.Name = shapeName;
    
14. 
    
15. }
    

复制代码

这样可以添加艺术字，不知道是不是你要的效果

xwdys

一步001 发表于 2024-4-11 10:52
这样可以添加艺术字，不知道是不是你要的效果

非常感谢！可以实现，只是每次都需AddTextEffect。因为要循环利用shape，原想利用已有的shape（excel可以）。
【原代码功能：利用Excel实现单位会场快速排座位并打印座位牌。因需转到wps中，故作代码移植。】

1. function test() {
   
2.     let n=0;//增加艺术字垂直方向上的距离
   
3.     ArtWord("shapeName1", "hello",n);
   
4.     n++;
   
5.     ArtWord("shapeName2", "World",n);
   
6. }
   
7. 
   
8. function ArtWord(shapeName, txt, n) {
   
9.     var newArtWord;
   
10.     var sht1 = Worksheets("Sheet1");
    
11.     newArtWord = sht1.Shapes.AddTextEffect(msoTextEffect1, txt, "黑体", 24, msoFalse, msoFalse, 40, 50*(n+1));
    
12.     newArtWord.Name = shapeName;
    
13.         MsgBox("pause...");
    
14.         if(n>0){
    
15.             sht1.Shapes("shapeName1").Delete();
    
16.             sht1.Shapes("shapeName2").Delete();               
    
17.         }
    
18. }

复制代码