Здравствуйте. Нашел макрос на просторах интернета для вставки фотографий из заданной папки, в принципе даже апгрейдил его для работы сразу на всех листах: [vba]
Код
Sub AddOlEObject()
Dim mainWorkBook As Workbook
Set mainWorkBook = ActiveWorkbook
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i)
Sheets(i).Activate
Folder = Range("H2")
Folderpath = Folder '
Set fso = CreateObject("Scripting.FileSystemObject")
NoOfFiles = fso.GetFolder(Folder).Files.Count
Set listfiles = fso.GetFolder(Folderpath).Files
For Each fls In listfiles
strCompFilePath = Folder & "\" & Trim(fls.Name)
If strCompFilePath <> "" Then
If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _ Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _ Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then counter = counter + 25 Call insert(strCompFilePath, counter - 15) Sheets(i).Activate End If End If Next mainWorkBook.Save End With Next End Sub
Function insert(PicPath, counter)
With ActiveSheet.Pictures.insert(PicPath) With .ShapeRange .LockAspectRatio = msoTrue .Width = 200 .Height = 375 End With .Left = ActiveSheet.Range("B" & counter).Left .Top = ActiveSheet.Range("B" & counter).Top .Placement = 1 .PrintObject = True End With End Function
[/vba]
Но я не могу понять что нужно изменить, что бы фотографии на новом листе вставлялись с такой же строки как в первом листе, а не с номера последней строки фотографии предыдущего листа.
В принципе всегда находил ответы на форумах (но и пользовался всегда формулами), а вот с макросами не все так просто как оказалось)
Спасибо, заранее!
Здравствуйте. Нашел макрос на просторах интернета для вставки фотографий из заданной папки, в принципе даже апгрейдил его для работы сразу на всех листах: [vba]
Код
Sub AddOlEObject()
Dim mainWorkBook As Workbook
Set mainWorkBook = ActiveWorkbook
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i)
Sheets(i).Activate
Folder = Range("H2")
Folderpath = Folder '
Set fso = CreateObject("Scripting.FileSystemObject")
NoOfFiles = fso.GetFolder(Folder).Files.Count
Set listfiles = fso.GetFolder(Folderpath).Files
For Each fls In listfiles
strCompFilePath = Folder & "\" & Trim(fls.Name)
If strCompFilePath <> "" Then
If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _ Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _ Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then counter = counter + 25 Call insert(strCompFilePath, counter - 15) Sheets(i).Activate End If End If Next mainWorkBook.Save End With Next End Sub
Function insert(PicPath, counter)
With ActiveSheet.Pictures.insert(PicPath) With .ShapeRange .LockAspectRatio = msoTrue .Width = 200 .Height = 375 End With .Left = ActiveSheet.Range("B" & counter).Left .Top = ActiveSheet.Range("B" & counter).Top .Placement = 1 .PrintObject = True End With End Function
[/vba]
Но я не могу понять что нужно изменить, что бы фотографии на новом листе вставлялись с такой же строки как в первом листе, а не с номера последней строки фотографии предыдущего листа.
В принципе всегда находил ответы на форумах (но и пользовался всегда формулами), а вот с макросами не все так просто как оказалось)