VBA批量插入图片后怎么实现自动置于单元格底层

alisakura

再请教个问题，怎么将插入该单元格的图片自动“置于底层”？？
Private Sub CommandButton1_Click()
Dim pic_name As String
[F1].CurrentRegion.Clear
pic_name = Dir(ThisWorkbook.Path & "\图片\*.jpg")
Do While pic_name <> ""
[F1] = "图片名称"
pic_name = Left(pic_name, InStrRev(pic_name, ".") - 1)
[F65536].End(xlUp).Offset(1, 0) = pic_name
pic_name = Dir()
Loop
End Sub

请在以上代码里添加。

alisakura

搞定了图片居中，复制了这里面的代码
http://club.excelhome.net/thread-1218562-1-1.html

但是如何能让图片置于单元格底层呢？？？

alisakura

顶上去，录制了宏，仿照改了下，没能实现批量设置，因为得先填入每张图片的名称，但是批量插入的图片名称是不固定的。哪位高人帮改改？批量插入图片后，再自动将图片设置于底层，单元格上有文本框。
Sub macro1()
    Range("D6").Select
    ActiveSheet.Shapes.Range(Array("图片 5")).Select
    Selection.ShapeRange.ZOrder msoSendToBack
End Sub

alisakura

遍历sheet1里的图片，并置于单元格底层：
sub setback()
Application.ScreenUpdating = False
Dim sh As Shape
For Each sh In Sheet1.Shapes
    If sh.Type = 13 Then sh.Select
        With Selection
            .ShapeRange.ZOrder msoSendToBack
End With
Next
Application.ScreenUpdating = True
End Sub

咋在不同的表里就不行了呢？
哪位给个好方法？

jpj123

循环置于底层，开始操作的又在上面来了啊!建议你上传附件!

莫愁湖

alisakura 发表于 2015-9-30 21:32
遍历sheet1里的图片，并置于单元格底层：
sub setback()
Application.ScreenUpdating = False

遍历sheet1里的图片，并置于单元格底层：
sub setback()
Application.ScreenUpdating = False
Dim sh As Shape
For Each sh In Sheet1.Shapes
    If sh.Type = 13 Then
sh.Select
        With Selection
            .ShapeRange.ZOrder msoSendToBack
End With
Next
Application.ScreenUpdating = True
End Sub

莫愁湖

alisakura 发表于 2015-9-30 21:32
遍历sheet1里的图片，并置于单元格底层：
sub setback()
Application.ScreenUpdating = False

'遍历sheet1里的图片，并置于单元格底层：
Sub setback()
    Application.ScreenUpdating = False
    Dim sh As Shape
    For Each sh In Sheet1.Shapes
        If sh.Type = 13 Then
            sh.ZOrder msoSendToBack
        End If
    Next
    Application.ScreenUpdating = True
End Sub

ning84

Private Sub ll4()
    Dim ShpRng As ShapeRange
        Set ShpRng = Application.ActiveWindow.Selection.ShapeRange
        Debug.Print ShpRng.ZOrderPosition, ShpRng.Name
        ShpRng.ZOrder msoSendToBack
End Sub

Sub ll5()
   Dim Pres As Presentation
       Set Pres = Application.ActivePresentation
   Dim Sld As Slide, Slds As Slides
   Dim Shp As Shape, ShpRng As ShapeRange, Shps As Shapes
   Dim ii, jj, Str
       Set Slds = Pres.Slides
       For ii = 4 To Slds.Count
            Slds(ii).Select
            Set Shps = Slds(ii).Shapes
            Set Shp = Shps("Pic")
            Debug.Print Shp.Name
            Shp.Select msoTrue
            Shp.ZOrder msoSendToBack

            
       Next ii
      
End Sub