مشکل در انتقال به ورد با سورس

[YasserDivaR]

سلام من از ورد آبجکت استفاده کردم اما سوره بقره و متن های طولانی رو بش از 11 صفحه ارسال نمی کنه لطفا راهنمایی کنید دوستان من قسمت فارسی که خوانا نیست پیغام عدم نصب آفیس و چیز خاصی نیست با تشکر

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub Header(Hay As Word.Application)
On Error Resume Next
'write heder to word document

On Error GoTo ErrHandler

With Hay
.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
.Selection.Font.NameBi = setting.FontNameAll.Text
'.Selection.BoldRun
.Selection.Font.SizeBi = setting.FontsizeAll.Text
'.Selection.Font.Size = setting.fontsizeAll.Text

.Selection.TypeText Text:=Text1.Text + setting.Text1.Text

.Selection.TypeText Text:=Chr$(13) & Chr$(13)
' .Selection.TypeText Text:=Format(FormatDateTime(Date, 1))
.Selection.WholeStory
'border lines

.Selection.MoveRight Unit:=wdCharacter, Count:=1
'.Selection.InsertBreak Type:=wdPageBreak

' GoTo endofloop
.Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone

' If HebWord = True Then
' .Selection.Font.BoldBi = 0
' End If
End With

Exit Sub

ErrHandler:
' MsgBox "Error - " & Format(Err.Number) & " - " & Format(Err.Description) & " in header."
End Sub


کد دکمه ارسال

On Error Resume Next
Dim Hay As Object 'Object

' Resume to the next line following the error.
On Error Resume Next

' Attempt to reference Word which is already running.
Set Hay = GetObject(, "Word.Application")

' If true, Word is not running.
If Hay Is Nothing Then
' Create a new instance of the Word application.
'Set Hay = New Word.Application
'late binding for hebrew
Set Hay = CreateObject("Word.Application")

' If true, MS Word 8.0 is not installed.
If Hay Is Nothing Then
MsgBox "ßÇÑÈÑ ÚÒíÒ æÇŽå ÑÏÇÒ ãÇßÑæÓÇÝÊ æÑÏ ÈÑ Ñæí ÓíÓÊã ÔãÇ äÕÈ äãí ÈÇÔÏ" + vbNewLine + "ÏÑ ÕæÑÊ ÊãÇíá íßí ÇÒ äÇÑÔ åÇí ÒíÑ ÑÇ äÕÈ äãÇííÏ æ ÓÓ ÇÞÏÇã äãÇííÏ" + vbNewLine + "Microsoft Word 2010" + vbNewLine + "Microsoft Word 2007" + vbNewLine + "Microsoft Word 2003", vbOKOnly + vbInformation, "æÇŽå ÑÏÇÒ ãÇßÑæÓÇÝÊ íÇÝÊ äÔÏ"




Exit Sub
End If
End If

On Error GoTo ErrHandler
Hay.Visible = True
Hay.Documents.add

If WordHide = False Then

Hay.ActiveWindow.View.Type = wdPrintView
Hay.Application.WindowState = wdWindowStateMaximize
End If

Z = 1
With Hay
If HebWord = True Then 'Hebrew
Z = 991
.Selection.LtrPara
Z = 1
Else
If .Selection.ParagraphFormat.Alignment <> wdAlignParagraphRight Then
.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight

End If
End If
Z = 999
'pagenum
.Selection.Sections(1).Footers(1).PageNumbers.add PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=False
Z = 11
'''''''''''''''''''''''''''Header''''''''''''''''' '''''''''''''''''''
.Selection.Font.Size = setting.FontsizeAll.Text


Header Hay
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
''''''end header

SavingFile = setting.Text2.Text & List1.Text & ".doc"

End With
'save

Hay.ActiveDocument.SaveAs FileName:=SavingFile, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False

ErrHandler:
' MsgBox "Error - " & Format(Err.Number) & " - " & Format(Err.Description) & " in Word_format phase - " & Str$(Z)
End Sub