كمك فوري براي OLE

[Parham.D]

يك سوال ساده از شما بزرگواران دارم.

آيا ميتوان با OLE برنامه Word را اجرا كرد ( در زمان اجرا)؟ (WinWord.exe)

با سپاس از شما

[r0ot$harp]

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




باتشکر احسان

[tefos666]

سلام دوست عزیز ببین اینا کارت رو راه میندازه ؟



Function MSWordDocOpen() As Integer
Screen.MousePointer = ccHourglass
On Error Resume Next
Set goword = Nothing 'Check to see if word is running
Set goword = GetObject(, "Word.Application")
If goword Is Nothing Then
Set goword = CreateObject("Word.Application")
gbWordRunning = True
End If
If goword Is Nothing Then
MsgBox "Can't create Word Object"
MSWordDocOpen = False
Else
MSWordDocOpen = True
End If
Screen.MousePointer = ccDefault
End Function

Function Opendoc() As Integer
'Function to Authorised Document
Dim strMsg As String
Dim cfilename As String
Dim Opened As Integer

MSWordDocOpen

goword.ChangeFileOpenDirectory ("\\SeverName"\Test")
goword.Documents.Open filename:= "Test.doc", addtorecentFiles:=False,

goword.Selection.TypeText Text:="Test 123"

End Function



اینم کد بعدی


Sub MoveGridToWord(SGg As Object, nHeadings As Integer, strTitle As String)
|
Dim i As Integer, j As Integer
Dim tmpstr As String
Dim ErrorLine As Integer

On Error GoTo WORDERROR

Dim nRows As Integer 'Number of rows
Dim nCols As Integer 'Number of Columns
Dim RowStart As Integer 'Number of first row to copy to Word

nRows = SGg.Rows - 1
nCols = SGg.Cols - 1
RowStart = nHeadings + 1

On Error Resume Next
Set tObj = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set tObj = CreateObject("Word.Application")
End If
On Error GoTo WORDERROR
tObj.Visible = True
Set Obj = tObj.WordBasic
Obj.FileNew
Obj.appmaximize 1

Obj.Insert Chr(10) & Chr(13)
Obj.Insert Chr(10) & Chr(13)
Obj.CenterPara

'Change the font attributes
Obj.Bold
Obj.FontSize 24

'Insert text to a document
Obj.CharColor 9 'dark blue
Obj.Insert strTitle 'Trim(Me.Caption)
Obj.FormatBordersAndShading 0, 1, , , , , , , , , , , , , 0, 5, 9, 0, 0

Obj.EditBookmark "Empty1"
Obj.Insert Chr(10) & Chr(13)
Obj.FontSize 12

'Insert a table to a document


Obj.TableInsertTable 1, nCols, nRows, , , 23, 43
Obj.StartOfRow
Obj.StartOfColumn


' Create heding lines of table
'=============================
For j = 1 To nCols ' To 1 Step -1
SGg.Col = j
For i = 0 To nHeadings - 1
SGg.Row = i
tmpstr = tmpstr & SGg.Text & Chr(10)
Next
Obj.Insert tmpstr
tmpstr = ""
Obj.NextCell
Next

' Create text in the table
'=============================
For i = RowStart - 1 To SGg.Rows - 1
SGg.Row = i
For j = 1 To nCols '7 To 1 Step -1
SGg.Col = j
Obj.Insert SGg.Text
Obj.NextCell
Next
Next

Obj.EndOfDocument

Obj.EditGoTo "Empty1"
Obj.ParaDown

Exit Sub

WORDERROR:
MsgBox Err & ": " & Error(Err) & Space(10) & ErrorLine
Exit Sub


End Sub




اینم کد بعدی


Private Sub mnuCreateTimedMathTest_Click()
'
Dim oWord As Object
Dim oDoc As Object
Dim oTable As Object
Dim TRow As Integer
Dim TCol As Integer
Dim TempTime As Date
Dim myRange As Object
'
'Open the document as read-only.
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Open(frmMain.ProgramDrive & "\Program Files\Math_Wizard_Maker\TestFormat.doc",
, True)
oWord.Visible = True
'
'
Set oTable = oDoc.Tables(1)
TRow = 1
TCol = 0
For MFCount = 1 To NumMathFacts
TCol = TCol + 1
If ((TCol > 6) Or ((TCol > 3) And (TRow > 5))) Then
TCol = 1
TRow = TRow + 1
End If
If (TRow < 7) Then oTable.Cell(TRow, TCol).Range.Text = " " &
TopMFNum(MFCount) & vbCrLf & " " & MFOperator(MFCount) & " " & BottomMFNum(MFCount)
& vbCrLf & " --------" & vbCrLf & vbCrLf
If (TRow >= 7) Then oTable.Cell(TRow, TCol).Range.Text = " " &
TopMFNum(MFCount) & vbCrLf & " " & MFOperator(MFCount) & " " & BottomMFNum(MFCount)
& vbCrLf & " --------"
If (MFCount = 36) Then MFCount = NumMathFacts + 1
Next MFCount
'
If (NumMathFacts > 36) Then
MsgBox "Timed Tests only allow up to 36 Math Facts, all others have
been ignored."
End If
'
'Fill in the bookmarks.
oDoc.Bookmarks("Math_Fact_List_Title").Range.Text = cbxMFLName.Text
oDoc.Bookmarks("Math_Fact_List_Title2").Range.Text = cbxMFLName.Text
TempTime = CDate(Fix(TotalTime / 60) & ":" & ((TotalTime / 60) - Fix(TotalTime
/ 60)) * 60)
oDoc.Bookmarks("minutes").Range.Text = Format(TempTime, "short time")
oDoc.Bookmarks("Num_Possible").Range.Text = NumMathFacts
'
Set oWord = Nothing
'
End Sub

***************************************

Now I am trying to add .gif image into the table. I can't seem to get the
syntax right. I can easily add an image to the document with this code:
*******************************
Dim Pic As String
Pic = (frmMain.ProgramDrive & "\Program Files\Math_Wizard_Maker\badges\"
& BadgeName & ".gif")
oDoc.Shapes.addpicture Pic

**********************************************
But this doesn't get it into the table.

I have tried the following attempts (and about 1,000 others). All yielding:
"Run-Time error 438 - Object doesn't support this property or method"
*************************************************
TRow = 1
TCol = 1
oTable.Cell(TRow, TCol).Shapes.addpicture Pic
************************************************
TRow = 1
TCol = 1
oTable.Cell(TRow, TCol).Range.Shapes.addpicture Pic
************************************************

I even tried using a bookmark and pasting from the clipboard. This at least
made the picture appear over the table (in the wrong place, over the wrong
cell), but not actually in the table.
***********************************************
With oWord
Clipboard.Clear
Clipboard.SetData Picture1.Picture, vbCFBitmap
oDoc.Bookmarks("picture").Select
.selection.Paste
end with
***********************************************

[Parham.D]

شما كلي كد نوشتي، من تازه كار نادان از كجا بفهمم اين ها را؟؟؟؟؟؟


جواب من يك بله و خير ساده است و نهايتش يك كد نمونه كوچك!!!


كمك كنيد لطفا!!!