Like Tree3Likes

Request: VBA Code Convert to Word 2010

Reply
Page 1 of 2 1 2 LastLast
  1. #1

    Join Date
    Mar 2011
    Posts
    117

    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


  2. #2

    Join Date
    May 2009
    Posts
    5,439

    Have you tried OpenOffice? They have many import filters.


  3. #3

    Join Date
    Mar 2011
    Posts
    117

    Thanks for the update.

    In fact this customized option for such task. Could it be possible that you provide me the similar solution for...

    Regards,


  4. #4

    Join Date
    Aug 2010
    Location
    Tai Hang
    Posts
    747

    Maybe your company should manage it's upgrades a little better...and when it screws up legacy applications it should pay to get them fixed.


  5. #5

    Join Date
    Mar 2011
    Posts
    117

    yes mid_gen, you are right absolutely! but now i have to search the alternative for! the code is sucks....

    still need to figure out why the existing code is not working!

    anyway....keep it mind....if you find any solution ...do let me update about


  6. #6

    Join Date
    Feb 2011
    Posts
    367

    At a cheap price of HK$9000 per month, OP can hire someone directly from the Philippines to fix this issue

    MovingIn07 likes this.

  7. #7

    Join Date
    Mar 2011
    Posts
    117
    Quote Originally Posted by avengedsevenfold
    At a cheap price of HK$9000 per month, OP can hire someone directly from the Philippines to fix this issue
    For your update it was already rejected....but good memory! I do appreciate.

  8. #8

    Join Date
    Aug 2010
    Location
    Tai Hang
    Posts
    747

    FWIW, without looking into any detail, check your security settings. Newer versions of Office tend to lock down macro capability more by default with each release.


  9. #9

    Join Date
    Jan 2008
    Posts
    859

    I'll fix it for $8888HKD, PM me for bank details.


  10. #10

    Join Date
    Mar 2011
    Posts
    117
    Quote Originally Posted by mid_gen
    FWIW, without looking into any detail, check your security settings. Newer versions of Office tend to lock down macro capability more by default with each release.
    Thanks for the response. But i already enabled all the macro security settings. But as per my research may be the Application.Search function was replaced with some other file searching object which is still the question??

    Any help?

Reply
Page 1 of 2 1 2 LastLast