Results 1 to 6 of 6

HELP Request: VBA Code Convert to Word 2010

Threaded View

  1. #1
    Registered User
    Join Date
    01-22-2013
    Location
    Hong Kong
    MS-Off Ver
    Excel 2010
    Posts
    4

    HELP 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! (File is Attached..please open and check the code by pressing Alt+F11)

    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
    Attached Files Attached Files
    Last edited by arlu1201; 01-29-2013 at 04:47 AM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1