谢谢LONG_III ]高手赐教！图片格式处理

Long_III

把你的附件及代码都放上来看看，我也不是很清楚取消组合之后是否可行，得多试验试验

shape是针对所有图形，如果你仅针对某一块，是需要设置限制条件的

benkyou

QUOTE:

以下是引用Long_III在2007-4-5 14:35:41的发言：

把你的附件及代码都放上来看看，我也不是很清楚取消组合之后是否可行，得多试验试验

shape是针对所有图形，如果你仅针对某一块，是需要设置限制条件的

已通过下列方式实现

Sub 取消组合()
    Dim sht As Worksheet
    For Each sht In Sheets
     With sht
       .Activate
       For Each s In sht.Shapes
       If s.Type = msoGroup Then s.Ungroup
        Next
        End With
        Next
       
    MsgBox "取消所有图片组合"
End Sub

Sub 转换JPEG格式()
    Dim sht As Worksheet
    Dim p As Picture
    Dim a, b
    For Each sht In Sheets
        With sht
            .Activate
            For Each p In .Pictures
                a = p.Top
                b = p.Left
                p.Cut
                .PasteSpecial Format:="图片(JPEG)", Link:=False, DisplayAsIcon:=False
                Selection.Top = a
                Selection.Left = b
            Next
        End With
    Next
    Application.CutCopyMode = False
      MsgBox "图片格式转换完毕"
End Sub

如何将以上２个宏合为１个？

1  再怎么将取消组合 再组合

2 如何将粘贴后的图片设为叠放次序为"置于底层"

 

 

 

YVzfnWvZ.rar (143.91 KB, 下载次数: 6)

2007-4-5 15:05 上传

点击文件名下载附件
[求助]高手赐教！图片格式处理

[此贴子已经被作者于2007-4-5 15:32:43编辑过]

Long_III

比较难处理，合并两个宏可以简单的这么处理

Sub 转换JPEG格式()
    Dim sht As Worksheet
    Dim p As Picture
    Dim a, b
    取消组合
    For Each sht In Sheets
        With sht
            .Activate

……

如果图片和组合框有规律的话好办一点

假设组合的图片里不含有其他的独立的图形，那在取消组合的时候记录下这个组合图形对应单元格的位置，如

Sub 取消组合()
    Dim sht As Worksheet, s As Shape
    For Each sht In Sheets
        With sht
            .Activate
            For Each s In sht.Shapes
                If s.Type = msoGroup Then
                    Debug.Print s.TopLeftCell.Address, s.BottomRightCell.Address
                    s.Ungroup
                End If
            Next
        End With
    Next
    MsgBox "取消所有图片组合"
End Sub

及记录了图形所在位置的最左上角的单元格位置和最右下角的单元格位置，等剪切、粘贴之后，再在所有图形里循环，如果它的s.TopLeftCell.Address, s.BottomRightCell.Address在原先组合图形之类的，就把这几个图形组合，如果组合里面的为picture的话，就置底

楼主可以自己试验试验

benkyou

再次感谢Long_III

置底已通过下面方法实现

Sub 转换JPEG格式()
    Dim sht As Worksheet
    Dim p As Picture
    Dim a, b
    取消组合
    For Each sht In Sheets
        With sht
            .Activate
            For Each p In .Pictures
                a = p.Top
                b = p.Left
                p.Cut
                .PasteSpecial Format:="图片(JPEG)", Link:=False, DisplayAsIcon:=False
                Selection.Top = a
                Selection.Left = b
                Selection.ShapeRange.ZOrder msoSendToBack
            Next
        End With
    Next
    Application.CutCopyMode = False
      MsgBox "图片格式转换完毕"
End Sub

seide

benkyou 发表于 2007-4-5 15:05
QUOTE:以下是引用Long_III在2007-4-5 14:35:41的发言：把你的附件及代码都放上来看看，我也不是很清楚取消 ...

问题终于解决了，用VBA 批量插入的图片，文件在另的电脑打开后图片不显示，用此代码处理后问题迎刃而解。谢谢！