LEILAFATHI
جمعه 02 شهریور 1386, 16:02 عصر
با سلا م
لطفا اگه کسی میتونه به من کمک کنه
من میخوام با کد نویسی رکوردی که کاربر اون رو جستجو کرده را در صورتی که پیدا بشه در داخل یک جدول در برنامه word نمایش بده، تقریبا بیشتر کار انجام شده ولی نمیدونم چرا موقعی که میخوام رکورد دیگه ای رو نمایش بدم بهم error میده که بانک اطلاعاتی بازه و اجازه نمایش بقیه رکورد هارو بهم نمیده البته من تو جاهای مختلف سعی کردم اون رو ببندم ولی بی فایده بود ، امیدوارم کامل توضیح داده باشم وزود مشکلم حل بشه،البته کدها رو هم مینویسم,و eror هم اینه:run time error 37.5
Operation isnot allowed when the object is open
Dim con As New ADODB.Connection
Dim re As New ADODB.Recordset
Dim D_Word As New Word.Application
Dim WordFile As String
Dim accessfile As String
Private Sub Form_Load()
WordFile = App.Path + "\Sample.doc"
accessfile = App.Path + "\db.mdb"
end sub
Private Sub report1_Click()
On Error Resume Next
report1.Enabled = False
update.Enabled = True
WordFile = App.Path & "\Sample.Doc"
With con
.Provider = "Microsoft.Jet.OLEDB.3.51"
.ConnectionString = "Persist Security Info=False;Data Source=" & accessfile
con.Open
End With
With re
.CursorLocation = adUseClient
.Open "SELECT * FROM listshsarasar where tele='" & Text6.Text & "'", con, adOpenDynamic, adLockOptimistic, adCmdText
End With
If re.RecordCount = 0 Then
( aa = MsgBox("not found", vbOKOnly + vbCritical
re.Close
con.Close
Else
AccessToWord re, accessfile
If re.State = dbstateopen Then re.Close
If con.State = dbstateopen Then con.Close
End If
Exit Sub
Private Function AccessToWord(reSet As ADODB.Recordset, StrFileName As String)
On Error Resume Next
Dim a As Integer
Dim Rng As Range
Dim Tbl As Table
Dim Cl As Cell
Dim IRows As Integer
Dim IColumns As Integer
Dim StrText As String
Dim ICellRow As Integer
Dim ICellColumn As Integer
Dim ICtr As Integer
IColumns = 1
IRows = re.RecordCount
With D_Word
.Documents.Add
.DisplayAlerts = wdAlertsNone
.Visible = True
End With
Set Rng = D_Word.Selection.Range
Set Tbl = D_Word.Selection.Tables.Add(Rng, IRows, IColumns)
ICtr = 0
ICellRow = 1
ICellColumn = 1
For kgh = 1 To reSet.RecordCount
strcell = vbCrLf + "˜Ï ÔÚÈå: " + CStr(reSet!codeshobe) + vbCrLf + "ÊáÝä: " + reSet!tele + vbCrLf + "ÏæÑäÇÑ: " + reSet!dornevis + vbCrLf + "Ý˜Ó ÑæÒäÇãå: " + reSet!faxrozname + vbCrLf + "ÔåÑÓÊÇä: " + reSet!shahrestan + vbCrLf + "ÂÏÑÓ: " + reSet!addres + vbCrLf
Tbl.Cell(ICellRow, ICellColumn).Select
D_Word.Selection.Text = strcell
ICtr = ICtr + 1
re.MoveNext
ICellColumn = ICellColumn + 1
If ICellColumn = IColumns + 1 Then
ICellColumn = 1
ICellRow = ICellRow + 1
End If
Next
Tbl.Cell(1, 1).Select
D_Word.Selection.SelectCurrentAlignment
D_Word.Selection.Cells.Borders.InsideLineWidth = wdLineWidth300pt
D_Word.Selection.Cells.Borders.InsideLineStyle = wdLineStyleInset
D_Word.Selection.Borders.OutsideLineStyle = wdLineStyleDoubleWavy
D_Word.Selection.BoldRun
D_Word.Selection.Font.Size = 14
D_Word.Selection.Calculate
D_Word.Selection.Cells.DistributeHeight
D_Word.Selection.Cells.DistributeWidth
D_Word.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
D_Word.ActiveDocument.PageSetup.PaperSize = wdPaperA4
D_Word.Selection.FormattedText.ParagraphFormat.Ali gnment = wdAlignParagraphRight
D_Word.ActiveWindow.DisplayRulers = False
D_Word.DisplayRecentFiles = False
D_Word.DisplayScreenTips = False
D_Word.ActiveDocument.PrintPreview
D_Word.ActiveDocument.SaveAs WordFile
:عصبانی++:
لطفا اگه کسی میتونه به من کمک کنه
من میخوام با کد نویسی رکوردی که کاربر اون رو جستجو کرده را در صورتی که پیدا بشه در داخل یک جدول در برنامه word نمایش بده، تقریبا بیشتر کار انجام شده ولی نمیدونم چرا موقعی که میخوام رکورد دیگه ای رو نمایش بدم بهم error میده که بانک اطلاعاتی بازه و اجازه نمایش بقیه رکورد هارو بهم نمیده البته من تو جاهای مختلف سعی کردم اون رو ببندم ولی بی فایده بود ، امیدوارم کامل توضیح داده باشم وزود مشکلم حل بشه،البته کدها رو هم مینویسم,و eror هم اینه:run time error 37.5
Operation isnot allowed when the object is open
Dim con As New ADODB.Connection
Dim re As New ADODB.Recordset
Dim D_Word As New Word.Application
Dim WordFile As String
Dim accessfile As String
Private Sub Form_Load()
WordFile = App.Path + "\Sample.doc"
accessfile = App.Path + "\db.mdb"
end sub
Private Sub report1_Click()
On Error Resume Next
report1.Enabled = False
update.Enabled = True
WordFile = App.Path & "\Sample.Doc"
With con
.Provider = "Microsoft.Jet.OLEDB.3.51"
.ConnectionString = "Persist Security Info=False;Data Source=" & accessfile
con.Open
End With
With re
.CursorLocation = adUseClient
.Open "SELECT * FROM listshsarasar where tele='" & Text6.Text & "'", con, adOpenDynamic, adLockOptimistic, adCmdText
End With
If re.RecordCount = 0 Then
( aa = MsgBox("not found", vbOKOnly + vbCritical
re.Close
con.Close
Else
AccessToWord re, accessfile
If re.State = dbstateopen Then re.Close
If con.State = dbstateopen Then con.Close
End If
Exit Sub
Private Function AccessToWord(reSet As ADODB.Recordset, StrFileName As String)
On Error Resume Next
Dim a As Integer
Dim Rng As Range
Dim Tbl As Table
Dim Cl As Cell
Dim IRows As Integer
Dim IColumns As Integer
Dim StrText As String
Dim ICellRow As Integer
Dim ICellColumn As Integer
Dim ICtr As Integer
IColumns = 1
IRows = re.RecordCount
With D_Word
.Documents.Add
.DisplayAlerts = wdAlertsNone
.Visible = True
End With
Set Rng = D_Word.Selection.Range
Set Tbl = D_Word.Selection.Tables.Add(Rng, IRows, IColumns)
ICtr = 0
ICellRow = 1
ICellColumn = 1
For kgh = 1 To reSet.RecordCount
strcell = vbCrLf + "˜Ï ÔÚÈå: " + CStr(reSet!codeshobe) + vbCrLf + "ÊáÝä: " + reSet!tele + vbCrLf + "ÏæÑäÇÑ: " + reSet!dornevis + vbCrLf + "Ý˜Ó ÑæÒäÇãå: " + reSet!faxrozname + vbCrLf + "ÔåÑÓÊÇä: " + reSet!shahrestan + vbCrLf + "ÂÏÑÓ: " + reSet!addres + vbCrLf
Tbl.Cell(ICellRow, ICellColumn).Select
D_Word.Selection.Text = strcell
ICtr = ICtr + 1
re.MoveNext
ICellColumn = ICellColumn + 1
If ICellColumn = IColumns + 1 Then
ICellColumn = 1
ICellRow = ICellRow + 1
End If
Next
Tbl.Cell(1, 1).Select
D_Word.Selection.SelectCurrentAlignment
D_Word.Selection.Cells.Borders.InsideLineWidth = wdLineWidth300pt
D_Word.Selection.Cells.Borders.InsideLineStyle = wdLineStyleInset
D_Word.Selection.Borders.OutsideLineStyle = wdLineStyleDoubleWavy
D_Word.Selection.BoldRun
D_Word.Selection.Font.Size = 14
D_Word.Selection.Calculate
D_Word.Selection.Cells.DistributeHeight
D_Word.Selection.Cells.DistributeWidth
D_Word.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
D_Word.ActiveDocument.PageSetup.PaperSize = wdPaperA4
D_Word.Selection.FormattedText.ParagraphFormat.Ali gnment = wdAlignParagraphRight
D_Word.ActiveWindow.DisplayRulers = False
D_Word.DisplayRecentFiles = False
D_Word.DisplayScreenTips = False
D_Word.ActiveDocument.PrintPreview
D_Word.ActiveDocument.SaveAs WordFile
:عصبانی++: