Problem on VB 6.0 code
Hi,
I'm Dwij,inexperienced in VB 6.0 programming, i have been working on a code since long. the code runs as follows:-
Public Sub dn_formatreport()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Cible As Paragraph
dirige = App.Path
Set objfso = CreateObject("Scripting.FileSystemObject")
Set WordApp = CreateObject("Word.Application")
Set repertoire = objfso.GetFolder(dirige & "\Files")
WordApp.Visible = False
piedepage1 = "MCB Factors Ltd., MCB Centre, 9-15 Sir William Newton Street, Port Louis, Republic of Mauritius"
piedepage2 = "Company Number 57525, Telephone: (230) 202 5701, Fax: (230) 208 5082, email: mcb.factors@mcb.co.mu"
Form1.ProgressBar1.Value = 0
Form1.ProgressBar1.Max = repertoire.Files.Count
For Each element In repertoire.Files
Form1.ProgressBar1.Value = Form1.ProgressBar1.Value + 1
Set WordDoc = WordApp.Documents.Open(dirige & "\Files\" & element.Name)
With WordDoc.Sections(1)
.PageSetup.Orientation = wdOrientPortrait
.PageSetup.DifferentFirstPageHeaderFooter = False
.PageSetup.TopMargin = CentimetersToPoints(3.2)
.PageSetup.BottomMargin = CentimetersToPoints(2)
.PageSetup.LeftMargin = CentimetersToPoints(2.5)
.PageSetup.RightMargin = CentimetersToPoints(2.5)
.PageSetup.HeaderDistance = CentimetersToPoints(0)
.PageSetup.FooterDistance = CentimetersToPoints(0)
.Headers(wdHeaderFooterPrimary).Shapes.AddPicture FileName:=dirige & "\Images\logo.jpg", LinkToFile:=False, SaveWithDocument:=True, Left:=196, Width:=70, Height:=68
.Footers(wdHeaderFooterPrimary).Range.Text = piedepage1 & vbCr & piedepage2
.Footers(wdHeaderFooterPrimary).Range.Paragraphs.Alignment = wdAlignParagraphCenter
'.Footers(wdHeaderFooterPrimary).Range.Font.ColorIndex = Word.WdColorIndex.wdDarkRed
.Footers(wdHeaderFooterPrimary).Range.Font.Bold = True
.Footers(wdHeaderFooterPrimary).Range.Font.Size = 10
'.Footers(wdHeaderFooterPrimary).PageNumbers.Add
End With
For Each Cible In WordDoc.Paragraphs
Cible.Range.Select
If Trim(Cible.Range.Words(1)) = "Account" Then
Selection.MoveUp unit:=wdLine, Count:=1
Selection.EndKey unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
signedby = Trim(Selection.Text)
Selection.MoveUp unit:=wdLine, Count:=1
On Error Resume Next
Set objShape = Selection.InlineShapes.AddPicture(FileName:=dirige & "\Images\Signatures\" & signedby & ".jpg", LinkToFile:=False, SaveWithDocument:=True)
If Err.Number <> 0 Then
Set objShape = Selection.InlineShapes.AddPicture(FileName:=dirige & "\Images\Signatures\Sandra.jpg", LinkToFile:=False, SaveWithDocument:=True)
With objShape 'adapter l'index si d'autres images existantes dans le document
.LockAspectRatio = msoTrue
.Height = .Height * 0.85
.Width = .Width * 0.85
End With
Selection.MoveDown unit:=wdLine, Count:=1
Selection.MoveLeft unit:=wdCharacter, Count:=6
Selection.Text = "For "
Else
With objShape 'adapter l'index si d'autres images existantes dans le document
.LockAspectRatio = msoTrue
.Height = .Height * 0.85
.Width = .Width * 0.85
End With
End If
End If
Next
WordDoc.SaveAs FileName:=dirige & "\Files\" & element.Name, FileFormat:=wdFormatDocument
WordDoc.Close
Next
WordApp.Quit
Set WordApp = Nothing
End Sub
Hope someone could help me on this...
Cheers Dwij