Question

我正在使用下面的代码在excel文件中添加多个图片，但似乎在For循环中苦苦挣扎，所以我尝试了Do循环。问题是每次向同一个单元格添加相同的图片，实际上，下面的图片应该移动到下一个范围。非常感谢您的意见。

Sub ScopePics()

Dim fullpath, server, thefile, thisbook As String
Dim picname As String
Dim pic_location As String
Dim picnum As Integer
Dim picadd As String

Application.DisplayAlerts = False

File_name = Sheet2.Cells(3, 10)
pic_location = Sheet2.Cells(622, 10)
picname = Sheet2.Cells(623, 10)
pastePic = Sheet2.Cells(626, 10)
maxP = Sheet2.Cells(627, 10)
Scopebook = Sheet2.Cells(609, 10)
picnum = Sheet2.Cells(624, 10)
picadd = Sheet2.Cells(625, 10)

Do
Workbooks(Scopebook).Activate
Sheets("Scope of Work").Select

Range(pastePic).Select

'For x = 1 To maxP Step 1
 'picadd = picnum + 1

    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")

        If FS.FileExists(pic_location) Then

        ActiveSheet.Pictures.Insert(pic_location).Select

        With Selection

            .Left = Range(pastePic).Left + 5
            .Top = Range(pastePic).Top + 5

            .ShapeRange.LockAspectRatio = msoTrue
            .ShapeRange.Height = 35#
            .ShapeRange.Width = 45#

        End With

        ActiveSheet.Pictures(pic_location).Refresh 'Tried this to try to refresh but its not working. 

    End If
Windows(File_name).Activate

Sheets("Control").Select
Cells(624, 10).Value = Cells(624, 10).Value + 1
Calculate
Application.Wait (Now + #12:00:03 AM#) 'Tried this to see if the delay would help but still not working. 
Calculate
ActiveSheet.Pictures.Insert(pic_location).Refresh

Workbooks(Scopebook).Activate
Loop Until picnum = picadd

ActiveWindow.Close

End Sub

如果没有将相同的图片添加到同一单元格中，则插入图片不会循环

0 个答案: