Advertisement
Guest User

multiple image to doc

a guest
Feb 20th, 2018
71
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.90 KB | None | 0 0
  1. Sub InsertSpecificNumberOfPictureForEachPage()
  2. Dim StrFolder As String
  3. Dim strFile As String
  4. Dim objDoc As Document
  5. Dim dlgFile As FileDialog
  6. Dim objInlineShape As InlineShape
  7. Dim nResponse As Integer
  8. Dim strPictureNumber As Integer
  9. Dim strPictureSize As String
  10. Dim n As Integer
  11.  
  12. Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker)
  13.  
  14. With dlgFile
  15. If .Show = -1 Then
  16. StrFolder = .SelectedItems(1) & "\"
  17. Else
  18. MsgBox ("No Folder is selected!")
  19. Exit Sub
  20. End If
  21. End With
  22.  
  23. strFile = Dir(StrFolder & "*.*", vbNormal)
  24. strPictureNumber = InputBox("Input the number of the picture for each page", "Picture Number", "For exemple: 1")
  25. n = 1
  26.  
  27. While strFile <> ""
  28. Selection.InlineShapes.AddPicture FileName:=StrFolder & strFile, LinkToFile:=False, SaveWithDocument:=True
  29. Selection.TypeParagraph
  30. Selection.Collapse Direction:=wdCollapsEnd
  31. Selection.TypeText Text:=Left(strFile, InStrRev(strFile, ".") - 1)
  32. Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
  33. If ActiveDocument.InlineShapes.Count = strPictureNumber * n Then
  34. Selection.InsertNewPage
  35. Selection.TypeBackspace
  36. n = n + 1
  37. End If
  38. Selection.TypeParagraph
  39. strFile = Dir()
  40. Wend
  41.  
  42. For Each objInlineShape In ActiveDocument.InlineShapes
  43. objInlineShape.Select
  44. Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
  45. Next objInlineShape
  46.  
  47. nResponse = MsgBox("Do you want to resize all pictures?", 4, "Resize Picture")
  48. If nResponse = 6 Then
  49. strPictureSize = InputBox("Input the height and width of the picture, seperated by comma", "Height and Width", "For exemple:500,500")
  50. For Each objInlineShape In ActiveDocument.InlineShapes
  51. objInlineShape.Height = Split(strPictureSize, ",")(0)
  52. objInlineShape.Width = Split(strPictureSize, ",")(1)
  53. Next objInlineShape
  54. End If
  55. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement