Request: VBA Code Convert to Word 2010
Dear All,
My colleague was using the MACRO for fetching the photos for its quality control work. The VBA code is defined to simplify their work for enhancing the maximum possible productivity in less time ;)
But now as the company has upgraded to the latest version of Microsoft Office Word 2007 to Microsoft Office Word 2010. The code is not supported to the newer version or perhaps the coding framework not supporting.
I have also uploaded my screen shots for further clarification, if in case you need other info, please do let me know. But please expedite! :(
Following is the VB Code:
Dim pic(12), pictext(12)
Dim fotoname(1000) As String
Dim zahler, zahler2 As Integer
Dim strA
Private Sub Browse_Click()
Location.Hide
ChangeFileOpenDirectory ("C:\")
Set opendialog = Dialogs(wdDialogFileOpen)
opendialog.Display
Path.Text = CurDir
Location.Show
End Sub
Private Sub Cancel_Click()
End
End Sub
Private Sub OK_Click()
If OK.Value = False Then
Location.Hide
zahler2 = 1
strA = 1
Set fs = Application.FileSearch
With fs
.LookIn = Location.Path.Text
.FileName = "*.*"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
zahler = .FoundFiles.Count
Selection.PageSetup.TopMargin = InchesToPoints(0.13)
Selection.PageSetup.BottomMargin = InchesToPoints(0.25)
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Font.Size = 14
Selection.Font.Bold = wdToggle
Selection.Font.Name = "Arial"
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior
With Selection.Tables(1)
.AllowAutoFit = False
End With
With Selection.Tables(1)
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
Selection.Tables(1).Select
Selection.Rows.HeightRule = wdRowHeightExactly
Selection.Rows.Height = InchesToPoints(3.1)
Selection.TypeParagraph
For i = 1 To .FoundFiles.Count
fotoname(i) = .FoundFiles(i)
HelpText = Len(fotoname(i))
HelpText = Mid(fotoname(i), HelpText - 2, 3)
If HelpText = "JPG" Or HelpText = "jpg" Or HelpText = "bmp" Or HelpText = "tif" Then
Selection.InlineShapes.AddPicture FileName:=fotoname(i), _
LinkToFile:=False, SaveWithDocument:=True
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.InlineShapes(1).Fill.Visible = msoFalse
Selection.InlineShapes(1).Fill.Transparency = 0#
Selection.InlineShapes(1).Line.Weight = 0.75
Selection.InlineShapes(1).Line.Transparency = 0#
Selection.InlineShapes(1).Line.Visible = msoFalse
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Height = 180#
Selection.InlineShapes(1).Width = 239.75
Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
Selection.InlineShapes(1).PictureFormat.CropRight = 0#
Selection.InlineShapes(1).PictureFormat.CropTop = 0#
Selection.InlineShapes(1).PictureFormat.CropBottom = 0#
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Font.Size = 11
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Pict. "
Selection.TypeText Text:="0" + strA
Selection.HomeKey Unit:=wdLine
Selection.TypeText Text:=vbTab & " "
Selection.EndKey Unit:=wdLine
strA = strA + 1
Selection.TypeParagraph
Selection.MoveRight Unit:=wdCell
Selection.TypeParagraph
End If
Next i
End If
End With
End If
End Sub
