利用vba在word报名表内插入个人头像图片，为什么执行不下去

liudejia

学习其他人的代码，根据自己需要，修改了一下
利用vba在word表格内插入图片，为什么执行不下去？代码如下




Sub 插入图片()


Dim fd As FileDialog, arr(0 To 1), brr(0 To 1)
Set fd = Application.FileDialog(msoFileDialogFolderPicker)   '选择图片所在文件夹
fd.Show

12345
tupianming = Dir(fd.SelectedItems(1) & "\*.*")         '读取图片名称
'MsgBox (tupianming)

Do
     i = s + 1
     vv = VBA.Split(tupianming, ".")(0)
   '  MsgBox (vv)
     
     On Error Resume Next
     biaogeming = Replace(ActiveDocument.Tables(i).Cell(1, 2).Range, " ", "")          '读取表格中第一行每二列单元格的名称
     
          biaogeming = Left(biaogeming, Len(biaogeming) - 1)
    ' MsgBox (biaogeming)
   
   
    '现在的问题就是下面这个判断始终不能运行，不管是不是名字相同，都会跳出？？？？
   
     If biaogeming = vv Then                         '判断图片名称和单元格名称是否一致
     
     
     
     ActiveDocument.Tables(i).AllowAutoFit = False
     
     ActiveDocument.Tables(i).Cell(1, 7).Range.InlineShapes.AddPicture fd.SelectedItems(1) & "/" & tupianming
        ' fd.SelectedItems (1) & "/" & nm
         
     s = s + 1
     GoTo 12345
           If i = ActiveDocument.Tables.Count Then
             Exit Do
           End If
     
    End If
     
tupianming = Dir
Loop Until tupianming = ""

liudejia

新手，技术小白，路过的大神帮忙修改一下

wang-way

猜一个，看对不对，我觉得你要监视一下你的判断条件是不是true，不要用肉眼看

3190496160

Sub 插入图片()
Dim fd As FileDialog, arr(0 To 1), brr(0 To 1)
Set fd = Application.FileDialog(msoFileDialogFolderPicker)   '选择图片所在文件夹
fd.Show
tupianming = Dir(fd.SelectedItems(1) & "\*.*")         '读取图片名称
For Each shp In ActiveDocument.InlineShapes
    shp.Delete
Next shp '''删除原来的图片
Do While tupianming <> ""
    vv = VBA.Split(tupianming, ".")(0)
    For i = 1 To ActiveDocument.Tables.Count
        biaogeming = Trim(ActiveDocument.Tables(i).Cell(1, 2).Range)          '读取表格中第一行每二列单元格的名称
        biaogeming = Left(biaogeming, Len(biaogeming) - 1)
        If InStr(biaogeming, vv) > 0 Then                        '判断图片名称和单元格名称是否一致
            ActiveDocument.Tables(i).AllowAutoFit = False
            tt = fd.SelectedItems(1) & "\" & tupianming
            ActiveDocument.Tables(i).Cell(1, 7).Range.InlineShapes.AddPicture FileName:=tt, LinkToFile:=False, SaveWithDocument:=True '直接插入
            Exit For
        End If
    Next i
tupianming = Dir
Loop
End Sub

3190496160

3190496160

报名表.rar (906.07 KB, 下载次数: 18)

2024-6-24 11:28 上传

点击文件名下载附件

wang-way

1. Sub 编程好习惯()
   
2.    
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         If .Show = -1 Then
   
5.             fd = .SelectedItems(1) & ""
   
6.         Else
   
7.             Exit Sub '取消选择退出
   
8.         End If
   
9.     End With
   
10.               
    
11.     fn = Dir(fd & "*.*") 'FileName
    
12.     Do
    
13.         i = i + 1
    
14.         ' Image 文件名  剔除拓展名    删除手抖输入的空白
    
15.         img = Application.CleanString(VBA.Split(fn, ".")(0))
    
16.         '表格中的姓名
    
17.         nm = ActiveDocument.Tables(i).Cell(1, 2).Range.Text 'Name
    
18.         '表格文本后面有两个字符  你原来就是这里处理有问题
    
19.         nm = Left(nm, Len(nm) - 2)
    
20.         '  删除手抖输入的空白
    
21.         nm = Application.CleanString(nm)
    
22.         
    
23.         
    
24.         '判断文件名与姓名是否相符   你原来就是这里处理有问题
    
25.         If img = nm Then
    
26.             ActiveDocument.Tables(i).AllowAutoFit = False
    
27.             '串接图片文件路径
    
28.             fp = fd & fn
    
29.             '插入图片
    
30.             ActiveDocument.Tables(i).Cell(1, 7).Range.InlineShapes.AddPicture fp
    
31.         End If
    
32.                         
    
33.         '表格填满
    
34.         If i = ActiveDocument.Tables.Count Then Exit Do
    
35. 
    
36.         '下一个文件
    
37.         fn = Dir
    
38.     Loop Until fn = ""
    
39.             
    
40.             
    
41. End Sub
    
42. 
    
43. 
    

复制代码