求助各位大大 07版的VBA插入图片宏在13版里图片变成连接了 要怎么修改

shengzw9

1. 
   
2. Sub picture()
   
3. '
   
4. ' 快捷键: Ctrl+i
   
5. '
   
6. Dim i As Long, sPath As String, sfileName As String
   
7.     cColumn = ActiveCell.Column
   
8.     rRow = ActiveCell.Row
   
9.     sPath = "N:\图片库"
   
10.     Application.ScreenUpdating = False
    
11.     On Error Resume Next
    
12.     m = InputBox("输入插入图片开始行：")
    
13.     n = InputBox("输入插入图片结束行：")
    
14.     L = InputBox("输入插入图片的列号（大写B、C、D...）：")
    
15.     If Val(n) < Val(m) Or Application.IsNumber(Val(m)) = False Or Application.IsNumber(Val(n)) = False Then
    
16.     MsgBox ("输入不规范！")
    
17.     Exit Sub
    
18.     Else
    
19.          For i = Val(m) To Val(n)
    
20.          If Range("A" & i) <> "" Then
    
21.           sfileName = sPath & Range("A" & i) & ".jpg"
    
22.           Range(L & i).Select
    
23.           With ActiveSheet.Pictures.Insert(sfileName)
    
24.           .Top = Selection.Top
    
25.           .Left = Selection.Left
    
26.           .ShapeRange.LockAspectRatio = msoFalse
    
27.           .ShapeRange.Width = ActiveSheet.Columns(cColumn).ColumnWidth * 5.75
    
28.           .ShapeRange.Height = ActiveSheet.Rows(rRow).RowHeight
    
29.           .Placement = xlMoveAndSize
    
30.           .PrintObject = True
    
31.           End With
    
32.             If Err <> 0 Then
    
33.                 Err = 0
    
34.             End If
    
35.         End If
    
36.         Next i
    
37.       End If
    
38.     Application.ScreenUpdating = True
    
39. End Sub
    

复制代码

代码如上图 在07里完全没问题 在13里 插入的图片发给别的电脑无法显示图片 好像是insert picture的定义在13里只是连接图片 要换成add picture 不太懂用法
求助各路大神帮忙修改 要插入的图片能自适应单元格大小 自动缩放

shengzw9

自顶一下~~~~~~~~~

shengzw9

自顶一下~~~~~~~~~

shengzw9

求教各位大神了！

shengzw9

真心求教~~~~

shengzw9

逛了一圈论坛 有接近的 但是没一样的 自己改了改 还是没有达到原来的效果

Jason_WangSS

1. Sub picture()
   
2. '
   
3. ' 快捷键: Ctrl+i
   
4. '
   
5. Dim i As Long, sPath As String, sfileName As String
   
6. Dim shp As Shapes
   
7.     cColumn = ActiveCell.Column
   
8.     rRow = ActiveCell.Row
   
9.     sPath = "D:"
   
10.     Application.ScreenUpdating = False
    
11.     m = InputBox("输入插入图片开始行：")
    
12.     n = InputBox("输入插入图片结束行：")
    
13.     L = InputBox("输入插入图片的列号（大写B C D...）：")
    
14.     If Val(n) < Val(m) Or Application.IsNumber(Val(m)) = False Or Application.IsNumber(Val(n)) = False Then
    
15.     MsgBox ("输入不规范！")
    
16.     Exit Sub
    
17.     Else
    
18.          For i = Val(m) To Val(n)
    
19.          If Range("A" & i) <> "" Then
    
20.           sfileName = sPath & Range("A" & i) & ".png"
    
21.         
    
22.          ActiveSheet.Shapes.AddPicture(sfileName, msoTrue, msoTrue, Range(L & i).Left, Range(L & i).Top, Range(L & i).Width, Range(L & i).Height).Select
    
23.             If Err <> 0 Then
    
24.                 Err = 0
    
25.             End If
    
26.         End If
    
27.         Next i
    
28.       End If
    
29.     Application.ScreenUpdating = True
    
30. End Sub

复制代码