Импорт из Word

← →
Руслан © (2007-06-10 01:34) [0]

Здравствуйте!
Есть документ с тестовыми вопросами, каждый вопрос начинается символом "$$$". Мне надо импортировать этот документ в БД.
Открываю документ в Дельфи, нахожу сколько раз в ней встречается этот символ, находит нормально, потом по циклу пробую идти и копировать, а тут что то не так.
Это делается по циклу
MSWord.Selection.Find.ClearFormatting; MSWord.Selection.Find.Text := findtext; //в нашем случае "$$$" MSWord.Selection.Find.Forward := True; MSWord.Selection.Find.Execute(); If MSWord.Selection.Text=EndOfQtext Then MSWord.Selection.Delete; MSWord.Selection.MoveLeft(Unit:=wdCharacter, Count:=1); MSWord.Selection.MoveDown(Unit:=wdLine, Count:=7, Extend:=wdExtend); MSWord.Selection.Copy; MSWord.Selection.MoveDown(Unit:=wdLine, Count:=1);

Что нужно поменять, чтобы импорт работал нормально?
Есть работающий код импорта на Visual Basic, не могу ее перевести на Дельфи.

← →
keymaster © (2007-06-10 11:44) [1]

> Есть работающий код импорта на Visual Basic

Показывай. Переведем.

← →
русланннннннн (2007-06-10 17:57) [2]

Private Sub itmImport_Click()
Dim tFileName As String, EndOfQtext As String, clmnCount As Byte
Dim i As Long, j As Long, z As Long, maxQtn As Long, tStr As String, tVars As Byte
Dim PsprtHdr(7) As String, PH(6, 10000) As Long, PrOtv(10000) As String
On Error GoTo Err_Handler

PsprtHdr(1) = "Номер вопроса"
PsprtHdr(2) = "Номер темы"
PsprtHdr(3) = "Номер подтемы"
PsprtHdr(4) = "Курс"
PsprtHdr(5) = "Семестр"
PsprtHdr(6) = "Уровень сложности"
PsprtHdr(7) = "Правильный ответ"

With CommonDialog1
.DialogTitle = "Получить тест из MS Word:"
.FileName = ""
.Filter = "Файлы документов в формате MS Word, Rich Text (*.doc, *.rtf)|*.doc;*.rtf"
.ShowOpen
tFileName = .FileName
End With
If Len(tFileName) = 0 Then Exit Sub
"etot kod v principe ne nujen, no puskai postoit, vdrug ponadobitsya
"If Right$(LCase(tFileName), 4) <> ".doc" Or Right$(LCase(tFileName), 4) <> ".rtf" Then
" MsgBox "Выбран не тот формат файла!", vbCritical
" Exit Sub
"End If

← →
русланннннннн (2007-06-10 17:58) [3]

Дальше

EndOfQtext = InputBox("Что использовалось в качестве разделителя вопросов? (например символы $$$)", "Импорт теста из MS Word:") If Len(EndOfQtext) = 0 Then Exit Sub FileSystem.FileCopy tFileName, App.Path & "\import.doc" Me.MousePointer = 11 Frame1.Visible = False RichTextBox1.Visible = True ProgressBar1.Visible = True lblPrgBar.Visible = True lblPrgBar.Caption = "Сейчас нельзя открывать MS Word!!! " & "Выбран файл " & tFileName & " для импорта тестов." Call rtfBoxesEmpty Call MSWORDbuttons(False) Me.Refresh ProgressBar1.Value = 1 Set myWordImport = Nothing Set myWordImport = New Word.Application With myWordImport .Visible = False .Documents.Open App.Path & "\import.doc" lblPrgBar.Caption = "Сейчас нельзя открывать MS Word!!! " & "Идет анализ паспорта тестовых задании..." .Selection.Find.ClearFormatting .Selection.Find.Text = "ПАСПОРТ ТЕСТА" .Selection.Find.Execute If .Selection.Text = "ПАСПОРТ ТЕСТА" Then .Selection.Delete .Selection.GoTo(wdGoToTable, , , "1").Select "pasport testa maxQtn = .Selection.Tables(1).Rows.Count clmnCount = .Selection.Tables(1).Columns.Count For i = 1 To clmnCount Me.Refresh ProgressBar1.Value = Int((i * 100) / clmnCount) If ProgressBar1.Value > 99 Then ProgressBar1.Value = 100 Me.Refresh For j = 1 To 7 If Left$(.Selection.Tables(1).Cell(1, i).Range.Text, Len(PsprtHdr(j))) = PsprtHdr(j) Then For z = 2 To maxQtn "kol-vo voprosov iz pasporta testa If j = 7 Then PrOtv(z - 1) = GetAns(.Selection.Tables(1).Cell(z, i).Range.Text) "Debug.Print PsprtHdr(j) & ": " & PrOtv(z - 1) Else PH(j, z - 1) = Int(Val(.Selection.Tables(1).Cell(z, i).Range.Text)) "Debug.Print PsprtHdr(j) & ": " & PH(j, z - 1) End If Next z "voprosy Else "если вдруг надписи не совподают, то по расположению колонок таблицы "For z = 2 To maxQtn "кол-во вопросов из паспорта теста " PH(1, z - 1) = Int(Val(.Selection.Tables(1).Cell(z, 1).Range.Text)) " PH(2, z - 1) = Int(Val(.Selection.Tables(1).Cell(z, 2).Range.Text)) " PH(3, z - 1) = Int(Val(.Selection.Tables(1).Cell(z, 3).Range.Text)) " PH(4, z - 1) = Int(Val(.Selection.Tables(1).Cell(z, 4).Range.Text)) " PH(5, z - 1) = Int(Val(.Selection.Tables(1).Cell(z, 5).Range.Text)) " PH(6, z - 1) = Int(Val(.Selection.Tables(1).Cell(z, 6).Range.Text)) " If j = 7 Then PrOtv(z - 1) = GetAns(.Selection.Tables(1).Cell(z, clmnCount).Range.Text) "Next z "цикл по таблице паспорта теста End If Next j "proverka Next i "tablica - pasport testa

← →
русланннннннн (2007-06-10 17:59) [4]

maxQtn = maxQtn - 1 "udalenie pervoi stroki .Selection.Tables(1).Delete "udalit tablicu - pasport testa ProgressBar1.Value = 1 .Selection.HomeKey Unit:=wdStory "pereiti v nachalo documenta .Selection.Find.ClearFormatting .Selection.Find.Text = EndOfQtext .Selection.Find.Execute i = 0: j = 0 Do Until .Selection.Find.Found <> True lblPrgBar.Caption = "Сейчас нельзя открывать MS Word!!! " & "Подсчет количества вопросов: " & i .Selection.Find.Execute i = i + 1 Loop .Selection.HomeKey Unit:=wdStory If i = 0 Then MsgBox "Разделитель вопросов не найден!" & vbCr & "Попробуйте еще раз...", vbExclamation Else If i > maxQtn Then MsgBox "Количество вопросов в паспорте МЕНЬШЕ чем в тестовых заданиях!" & vbCr & "В паспорте вопросов указано:" & maxQtn & " В тестовых заданиях вопросов: " & i, vbExclamation End If If i < maxQtn Then MsgBox "Количество вопросов в паспорте БОЛЬШЕ чем в тестовых заданиях!" & vbCr & "В паспорте вопросов указано:" & maxQtn & " В тестовых заданиях вопросов: " & i, vbExclamation End If End If For j = 1 To i .Selection.Find.Execute ProgressBar1.Value = Int((j * 100) / i) If ProgressBar1.Value > 99 Then ProgressBar1.Value = 100 lblPrgBar.Caption = "Сейчас нельзя открывать MS Word!!! " & "Импорт вопроса под номером: " & j If j = i Then .Selection.Find.Execute If .Selection.Text = EndOfQtext Then .Selection.Delete .Selection.EndKey Unit:=wdStory, Extend:=wdExtend Else ".Selection.HomeKey Unit:=wdLine .Selection.HomeKey Unit:=wdStory, Extend:=wdExtend End If If Len(.Selection.Text) <= 1 Then .Selection.Find.Execute If .Selection.Text = EndOfQtext Then .Selection.Delete .Selection.Find.Execute ".Selection.HomeKey Unit:=wdLine .Selection.HomeKey Unit:=wdStory, Extend:=wdExtend If Len(.Selection.Text) <= 1 Then Exit For End If .Selection.Copy Call cmdNew_Click RichTextBox1.TextRTF = Clipboard.GetText(&HBF01) "Rich Text Format (.rtf file) If PH(1, j) = j Then "eto proverka vibrannih otvetov po ih nomeram cmbTema.Text = PH(2, j) cmbPodtema.Text = PH(3, j) cmbKurs.Text = PH(4, j) cmbSemestr.Text = PH(5, j) cmbSlojnost.Text = PH(6, j) If IsNumeric(Int(Val(PrOtv(j)))) = True And Int(Val(PrOtv(j))) > 0 And Int(Val(PrOtv(j))) < 9 Then opt1(Int(Val(PrOtv(j))) - 1).Value = True Else "Mnojestv vibor doljen razdelyatsya tolko zapyatymi... tVars = Count_Delim_Words(",", PrOtv(j)) If tVars <> 0 Then Call AnswerVariantsImport1(PrOtv(j), ",", tVars) Else Call AnswerVariantsImport2(PrOtv(j)) End If End If "Pravilnie otvety End If cmdEditQ.Caption = "Сохранить этот вопрос" Call cmdEditQ_Click "vizov procedury chtoby sohranit... .Selection.Delete .Selection.Find.Execute If .Selection.Text = EndOfQtext Then .Selection.Delete Next j .Documents.Close .Quit SaveChanges:=wdDoNotSaveChanges End With ProgressBar1.Value = 100 FileSystem.Kill App.Path & "\import.doc" ProgressBar1.Visible = False lblPrgBar.Visible = False RichTextBox1.Visible = True Frame1.Visible = True tbToolBar.Buttons(9).Enabled = True itmExport.Enabled = True tbToolBar.Buttons(4).ButtonMenus.Item(2).Enabled = True Call MSWORDbuttons(True) Me.Refresh Me.MousePointer = 0 Exit Sub Err_Handler: Call err_recording(Err.Description, Err.Source, Now, Err.Number, _ Me.Name & "\Sub itmImport_Click()") "MsgBox Err.Description & "; " & Err.Source & "; " & Now & "; " & Err.Number & "; " & _ Me.Name & "\Sub itmImport_Click()" & vbCr & gethelp, vbCritical, "Возникла ошибка:" Err.Clear Resume Next End Sub

← →
русланннннннн (2007-06-10 18:01) [5]

Прошу прощения за длинный код ;)

> Есть работающий код импорта на Visual Basic, не могу ее
> перевести на Дельфи.

а ты не переводи, запускай ворд через OLE, в дельфи в седьмой ведь есть импортированные классы всего офиса

поищи свойство macros, передай ему этот текст и запускай

(сам не пробовал естессно :) )

Импорт из Word Найти похожие ветки