Excel里用VBA代码插入图片不随文件保存的问题

bb75308973

当我选定单元格 按插入 选择图片 然后保存 如果我移动原始图片位置 再打开表格 图片还在
但是我把我刚才的办法录制宏得出代码是用这种方式插入图片的 Pictures.Insert
但若要是我移动原始图片位置再打开表格的话会无法显示
唉 只能一张一张插入么?
表格我要发给别人的,但是图片我不发给别人啊!
这样别人打开就看不到图片了
有没有高人!!!

爱疯

1）Pictures.Insert方法，因为在文档中只存储链接信息，所以有链接失效的可能。换为Shapes.AddPicture 方法可避免：
    With ActiveCell
        ActiveSheet.Shapes.AddPicture Filename:="c:\0.gif", _
                LinkToFile:=True, SaveWithDocument:=True, _
                Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height
    End With

2）循环插入即可。

bb75308973

爱疯 发表于 2013-4-10 17:41
1）Pictures.Insert方法，因为在文档中只存储链接信息，所以有链接失效的可能。换为Shapes.AddPicture 方法 ...

我每张图的比例不一样啊 那个尺寸我不好填 而且必须要填 这样我的图就会变形啊!

爱疯

bb75308973 发表于 2013-4-10 17:57
我每张图的比例不一样啊 那个尺寸我不好填 而且必须要填 这样我的图就会变形啊!

不明白这句的意思，也不明白结果的效果
如果有多个图片，不妨先处理决3个图片，手工给出结果的效果，上传附件，就好知道了。

bb75308973

爱疯 发表于 2013-4-10 18:11
不明白这句的意思，也不明白结果的效果
如果有多个图片，不妨先处理决3个图片，手工给出结果的效果，上传 ...

我的意思其实就是如果用代码插入图片的话保存后只是存了个链接 图片换位置就找不到了
我就是想用代码搞进来的图片不要与我的原图有链接关系 可以保存在文件里

不过我用笨办法解决了
原理就是先插入图片算出他的高宽比 然后再删除 再用Shapes.AddPicture方法把图片整进来 这样也不用担心图片大了文件就大 自然压缩了
可就是速度相当地慢啊!
看代码:

1. Sub 宏1()
   
2. 
   
3. Dim i, a, b
   
4. Dim n As Integer
   
5. Dim sh As Worksheet
   
6. Set sh = ActiveSheet
   
7. b = Range("B1").Width '算出单元格的宽度后面将图片居中用
   
8. On Error Resume Next
   
9. Application.ScreenUpdating = False
   
10. For n = 1 To Range("A65536").End(xlUp).Row
    
11.     Range("B" & n).Select
    
12.     sh.Pictures.Insert("C:\Users\Administrator\Desktop\新建文件夹" & Range("A" & n) & ".JPG").Select
    
13.     i = Selection.ShapeRange.Width / Selection.ShapeRange.Height '算出图片高宽比
    
14.     Selection.Delete '删除链接图
    
15.     sh.Shapes.AddPicture("C:\Users\Administrator\Desktop\新建文件夹" & Range("A" & n) & ".JPG", True, True, Range("B" & n).Left, Range("B" & n).Top, 96 * i, 96).Select '用形状插入图片 自然压缩了
    
16.     a = (b - Selection.ShapeRange.Width) / 2 '移动的距离将图片居中
    
17.     Selection.ShapeRange.IncrementLeft a
    
18.     Selection.ShapeRange.IncrementTop 2
    
19. Next
    
20. Application.ScreenUpdating = True
    
21. On Error GoTo 0
    
22. End Sub
    

复制代码

爱疯

记录比例是个好主意。

每次循环，你都执行了2次插入图片和1次删除图片。应该1次插入图片就行了吧。

上传附件，分享下吧

bb75308973

爱疯 发表于 2013-4-10 19:43
记录比例是个好主意。

每次循环，你都执行了2次插入图片和1次删除图片。应该1次插入图片就行了吧。

没有附件 随便新建个 然后弄些照片就行了
我记得有办法直接读取图片的长宽像素信息的 但是不知道是什么代码
我这个笨办法 效率很低 很慢 十多张图就要一两秒钟

ActiveSheet.Shapes.AddPicture 我还发现一个问题，每次打开文档时，都会自动更新一次图片，弄得打开文件好慢

QQ_0D2F24 发表于 2014-10-3 14:17
ActiveSheet.Shapes.AddPicture 我还发现一个问题，每次打开文档时，都会自动更新一次图片，弄得打开文件好 ...

求高手解决的办法

54mikeho

我找到了一个解决办法！
以前在Excel2003中用picture.insert方法写的代码，到了Excel2010中只能插入链接，图片不能随文件一起保存，不得不改为shapes.addpicture, 也同样遇到上面所说的图片宽高比例的问题。经过一悉研究，好像找到了完美的方法，请各位指正。
-----------------------------------------
Shapes.AddPicture 最后两个参数用-1,-1表示按图片原始尺寸插入
ActiveSheet.Shapes(ActiveSheet.Shapes.Count)可以引用刚插入的图片，从而可以读取图片宽和高，以及进行缩放。

例：
假如图片所在路径为 PicPath,要插入单元格为A1,即Cells(1,1),若要插入的图片自动适应A1单元格，并且保持宽高比，可用以下代码：

         
With Cells(1, 1)
     PicL = .Left + .Width * 0.05
     PicT = .Top + .Height * 0.05
     PicW = .Width * 0.9
     PicH = .Height * 0.9
End With
         
With ActiveSheet.Shapes.AddPicture(PicPath, True, True, 0, 0, -1, -1)
End With
               
Set shp = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    rh = PicH / shp.Height
    rw = PicW / shp.Width
    r = IIf(rw > rh, rh, rw)
    shp.Left = PicL
    shp.Top = PicT
    shp.ScaleWidth r, msoFalse, msoScaleFromTopLeft
--------------------------------------
如果配上循环语句，可以批量插入图片。