Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Технологии > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 15 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 23.02.2014, 17:37   #1
Ship_1
Участник клуба
 
Регистрация: 10.02.2014
Сообщений: 523
Репутация: 60
Лампочка Перенос значений таблицы из MS Excel в MS Word. Delphi. Шпаргалка и "разбор полётов".

Раз уж здесь обосновался - напишу здесь эту тему.
Поводов написать аж четыре:
1. Может пригодиться тем, кто столкнётся с теми же вопросами;
2. Может, кто-то из знающих скажет как можно сделать лучше;
3. Сам потом смогу взять отсюда нужный фрагмент или мысль;
4. Ну и есть нерешённые вопросы, которые я вставлю по ходу описания. Может, подскажет кто чего.

Всё использованное мной нарыто в разных местах интернета. Единого понятного источника найти не удалось. Попробую собрать информацию в одном месте.

Суть задачи.
1. Есть Экселевский файл, лежит в папке с программой, "УС.xlsx", содержащий таблицы с данными: пять/шесть колонок, произвольное количество строк. Листов (вкладок) с такими таблицами тоже произвольное. Некоторые строки (с названиями разделов или подразделов) объединены по горизонтали в одну (5 в 1 или 6 в 1). Встречается форматирование шрифта в названии разделов (полужирный, подчёркивание, курсив).
2. Есть Вордовый документ-шаблон из двух листов, тоже в папке программы, "УС.doc". На первом - "титульный лист" с колонтитулами, штампом, содержанием и загаловком; на втором колонтитулы с штампом и "шапкой" таблицы и одна строка таблицы с нужным количеством ячеек (столбцов) и установленной шириной.
3. Цель: перенести таблицу из Экселя в Ворд.
3.1. Объединённые ячейки Экселя объединить и в ворде
3.2. Форматирование шрифта (жирный/курсив/подчёркивание) перенести только из названий разделов/подразделов (объединённые строки).
3.3. В объединённых строках выравнивание в ячейке перенести полностью, в остальных - по конкретным правилам: по вертикали - все по центру; по горизонтали: 2, 5(6) - по левому краю, остальные - по середине.
3.4. Данные с новой вкладки (листа) Экселя должны начинаться с нового листа Ворда.
3.5. Не все вкладки (листы) может быть нужно переносить в Ворд.

На данный момент для 5 или 6 столбцов предполагается использовать разные шаблоны. После "обстреливания" программы пойду дальше разбираться и сделаю программное разделение 4-го столбца.

Моё решение задачи.

На форме:
1. CheckListBox - для вывода названий вкладок
2. CheckBox - если с галочкой, то столбцов 6
3. Кнопка - для старта переноса
4. Memo - для вывода всяких сообщений, которые могут пригодится.

Всё делается без дополнительных компонентов по работе с Экселем и Вордом.

В тексте программы:

Используемые переменные:
Код:

  MyExcel: OleVariant; // объест Excel.Application
  MyWord: OleVariant; // объест Word.Application

Константы:
Код:

const ExcelApp = 'Excel.Application';
      WordApp = 'Word.Application';
      NameBook = 'УС.xlsx';
      NameDoc = 'УС.doc';

1. Получаем все вкладки Экселя
1.1. При создании формы (событие "FormCreate") последовательно проверяем:
1.1.1. установлен ли Эксель на компьютере.
Код:

function CheckExcelInstall:boolean;
var
  ClassID: TCLSID;  //uses Classes
  Rez : HRESULT;
begin
// Ищем CLSID OLE-объекта
  Rez := CLSIDFromProgID(PWideChar(WideString(ExcelApp)), ClassID);
  if Rez = S_OK then  // Объект найден
    Result := true
  else
    Result := false;
end;

(функция стащена целиком в чистом виде не помню откуда - под рукой источника нет)
1.1.2. Запущен ли Эксель
Код:

function CheckExcelRun: boolean;
begin
  try
    MyExcel:=GetActiveOleObject(ExcelApp);
    Result:=True;
  except
    Result:=false;
  end;
end;

1.2. И, если предыдущие шаги выполнены, пробуем запустить Эксель:
Код:

function RunExcel(DisableAlerts:boolean=true; Visible: boolean=false): boolean;
begin
  try
{проверяем установлен ли Excel}
    if CheckExcelInstall then
      begin
        MyExcel:=CreateOleObject(ExcelApp);
//показывать/не показывать системные сообщения Excel (лучше не показывать)
        MyExcel.Application.EnableEvents:=DisableAlerts;
        MyExcel.Visible:=Visible;
        Result:=true;
      end
    else
      begin
        MessageBox(0,'Приложение MS Excel не установлено на этом компьютере','Ошибка',MB_OK+MB_ICONERROR);
        Result:=false;
      end;
  except
    ShowMessage('Возникла ошибка при запуске Экселя');
    Result:=false;
  end;
end;

(Да, я знаю, что у меня тут повторная, вроде не нужная, проверка на установленность, но пока решил не убирать.)

Последний раз редактировалось Ship_1; 23.02.2014 в 18:39.
Ship_1 вне форума   Ответить с цитированием
Старый 23.02.2014, 17:40   #2
Ship_1
Участник клуба
 
Регистрация: 10.02.2014
Сообщений: 523
Репутация: 60
По умолчанию (продолжение)

И вот тут у меня первый вопрос знатокам:
Между строками
Код:

        MyExcel.Application.EnableEvents:=DisableAlerts;
        MyExcel.Visible:=Visible;

у меня вдруг в какой-то момент программа стала наглухо зависать. Её нельзя было даже закрыть из диспетчера задач. Потом прошло и больше не повторялось, но озадачило сильно. Место выловил, расставив "ShowMessage" на каждый шаг. Так и выловил. Перед этой связкой сообщение показывалось - после уже нет. Когда поставил между ними - уже всё прошло и при очищении потом функции от показа сообщений уже больше не повторялось. Мысль: может, Ворд при первом запуске на недавно включенном компьютере долго загружался, или Винда ещё сама не дозагрузилась и тормозила Ворд... Но всё зависало. Как уберечься от таких казусов?
1.3. Пробуем открыть нужный файл:
Код:

function OpenBook(BookName:string; var WBIndex:integer):boolean;
var i:integer;
begin
  if CheckExcelRun then
  begin
    MyExcel.WorkBooks.Open(ExtractFilePath(Application.ExeName)+BookName, true);
    Result:=True;
    WBIndex:=0;
    for i:=1 to MyExcel.WorkBooks.Count do
    begin
       if AnsiLowerCase(MyExcel.WorkBooks[i].Name)=AnsiLowerCase(BookName) then
         WBIndex:=i;
    end
  end
  else
    Result:=false;
end;

Кроме результата об успешности открытия файла в переменной "WBIndex" получаем номер открытого файла в списке открытых в Экселе (может пригодиться, если это не единственный открытый файл).
1.4. Если открытие прошло успешно - получаем необходимый список вкладок, выводя их в CheckListBox, чтобы там можно было выбрать какие вкладки переносить в Ворд.
Код:

      for i:=1 to MyExcel.WorkBooks.Item[1].Sheets.Count do
        CheckListBox1.Items.Add(MyExcel.WorkBooks.Item[1].Sheets.Item[i].Name);

1.5. Целиком часть с запуском Экселя и считыванием вкладок.
Код:

//============= Эапуск Экселя
  if CheckExcelInstall then  // Объект найден
  Begin
    if CheckExcelRun then  // Объект запущен
      Form1.Memo1.Lines.Add('Запуск MS Excel был произведён ранее')
    else
    Begin
      Form1.Memo1.Lines.Add('Запуск MS Excel');
      If RunExcel then Form1.Memo1.Lines.Add('Запуск MS Excel прошёл успешно')
                  else Form1.Memo1.Lines.Add('При попытке запуска MS Excel произошёл сбой');
    End;

    // открытие файла
    if OpenBook(NameBook,XLBInd) then
    begin
      Form1.Memo1.Lines.Add('Книга '+MyExcel.WorkBooks.Item[1].FullName+' открыта');
      TBInd:=XLBInd;

      for i:=1 to MyExcel.WorkBooks.Item[1].Sheets.Count do
        CheckListBox1.Items.Add(MyExcel.WorkBooks.Item[1].Sheets.Item[i].Name);

      OpExState:=0;

    end
    else
    begin
      Form1.Memo1.Lines.Add('Возникли проблемы с открытием книги '+MyExcel.WorkBooks.Item[1].FullName);
      OpExState:=2;
    end;
  End
  else
  begin
    Form1.Memo1.Lines.Add('MS Excel не установлен.');
    OpExState:=3;
  End;
//============= Конец Эапуска Экселя

Переменная "OpExState" (стадия открытия) мне нужна чтоб была возможность понять на каком шаге произошёл сбой. Если сбоев не было - в её значении будет ноль.


1.6. Закрываем Эксель.
Проверяем переменную стадии открытия, установленность и запущенность Экселя. После этого если число открытых файлов больше одного - отыскиваем по имени наш файл и закрываем его, иначе (если файлов открыто не больше одного) закрываем Эксель.
Код:

function StopExcel:boolean;
begin
  try
    if MyExcel.Visible then MyExcel.Visible:=false;
    MyExcel.Quit;
    MyExcel:=Unassigned;
    Result:=True;
  except
    Result:=false;
  end;
end;

1.7. Целиком часть закрытия Экселя.
Код:

// ======== закрытие экселя ===========
  if OpExState=0 then
  begin
     if CheckExcelInstall then  // Объект найден
    Begin
      if CheckExcelRun then  // Объект запущен
      Begin
        if MyExcel.WorkBooks.Count>1 then
        begin
          for i:=1 to MyExcel.WorkBooks.Count do
             if AnsiLowerCase(MyExcel.WorkBooks[i].Name)=AnsiLowerCase(NameBook) then
             begin
               MyExcel.WorkBooks[i].Close;
               Form1.Memo1.Lines.Add('Кнгига-база закрыта, остальные файлы оставлены открытыми')
             end;
        end
        else
        begin
        if StopExcel then Form1.Memo1.Lines.Add('Загрузка данных прошла успешно; MS Excel закрыт.')
                     else Form1.Memo1.Lines.Add('Возникли проблемы при закрытии Экселя.');
        end;
      End
      else
        Form1.Memo1.Lines.Add('MS Excel не был запущен')
    End
    else
      Form1.Memo1.Lines.Add('MS Excel не установлен.')
  end
  else
  begin
    Form1.Memo1.Lines.Add('Возникла ошибка открытия файла Эксель номер '+IntToStr(OpExState));
  end;
// ======== конец закрытия экселя ===========


Последний раз редактировалось Ship_1; 23.02.2014 в 18:43.
Ship_1 вне форума   Ответить с цитированием
Старый 23.02.2014, 17:44   #3
Ship_1
Участник клуба
 
Регистрация: 10.02.2014
Сообщений: 523
Репутация: 60
По умолчанию (продолжение)

2. Сам перенос таблицы. На событии нажатия кнопки ("Button1Click").
2.1. Запускаем Эксель и открываем файл, повторяя шаги 1.1 - 1.3.
2.2. Запускаем Ворд и открываем шаблон по тому же принципу:
2.2.1. Проверяем установленность
Код:

function CheckWordInstall:boolean;
var
  ClassID: TCLSID;  //uses Classes
  Rez : HRESULT;
begin
// Ищем CLSID OLE-объекта
  Rez := CLSIDFromProgID(PWideChar(WideString(WordApp)), ClassID);
  if Rez = S_OK then  // Объект найден
    Result := true
  else
    Result := false;
end;

2.2.2. Проверяем, был ли уже запущен
Код:

function CheckWordRun: boolean;
begin
  try
    MyWord:=GetActiveOleObject(WordApp);
    Result:=True;
  except
    Result:=false;
  end;
end;

2.2.3. И запускаем
Код:

function RunWord(DisableAlerts:boolean=true; Visible: boolean=true): boolean;
begin
  try
{проверяем установлен ли Word}
    if CheckWordInstall then
      begin
        MyWord:=CreateOleObject(WordApp);
        MyWord.Visible:=Visible;
        Result:=true;
      end
    else
      begin
        MessageBox(0,'Приложение MS Word не установлено на этом компьютере','Ошибка',MB_OK+MB_ICONERROR);
        Result:=false;
      end;
  except
    Result:=false;
  end;
end;

Ещё один вопрос знатокам:
Код:

        MyWord.Application.EnableEvents:=DisableAlerts;

перетащенное мной из запуска Экселя, вызывает ошибку 'Method 'EnableEvents' not supported by automation object'. В чём может быть проблема?
2.2.4 Открываем файл
Код:

function OpenDoc(DocName:string; var WBIndex:integer):boolean;
var i:integer;
begin
  if CheckWordRun then
  begin
    MyWord.Documents.Open(ExtractFilePath(ExtractFilePath(Application.ExeName))+DocName, true);
    Result:=True;
    WBIndex:=0;
//    for i:=1 to MyWord.Documents.Count do
//    begin
//       if AnsiLowerCase(MyWord.Documents.Item(i).Name)=AnsiLowerCase(DocName) then
//         WBIndex:=i;
//    end
  end
  else
    Result:=false;
end;

Закомментированные строки теоретически возвращают номер открытого документа среди других открытых, но, т.к. у Ворда перечисление документов отличается от перечисления открытых книг Экселя, и вовремя я с этим разобраться не смог, то оставил "на потом". Теоретически, если раскомментировать, должно работать, но я пока не пробовал, т.к. разбираюсь в остальных частях программы и до этой пока не дошли руки.
2.2.5. Целиком часть открытия Вордаи файла документа.
Код:

//============= Эапуск Ворда
  if CheckWordInstall then  // Объект найден
  Begin
    if CheckWordRun then  // Объект запущен
      Form1.Memo1.Lines.Add('Запуск MS Word был произведён ранее')
    else
    Begin
      Form1.Memo1.Lines.Add('Запуск MS Word');
      If RunWord then Form1.Memo1.Lines.Add('Запуск MS Word прошёл успешно')
                  else Form1.Memo1.Lines.Add('При попытке запуска MS Word произошёл сбой');
    End;

    // открытие файла
    if OpenDoc(NameDoc,WDBInd) then
    begin
      Form1.Memo1.Lines.Add('Документ '+MyWord.ActiveDocument.Name+' открыт');
      DBInd:=WDBInd;
    end
    else
    begin
      Form1.Memo1.Lines.Add('Возникли проблемы с открытием документа '+MyWord.Documents.Item[1].FullName);
      OpWdState:=2;
    end;
  End
  else
  begin
    Form1.Memo1.Lines.Add('MS Word не установлен.');
    OpWdState:=3;
  End;
//============= Конец Эапуска Ворда


Последний раз редактировалось Ship_1; 23.02.2014 в 18:16.
Ship_1 вне форума   Ответить с цитированием
Старый 23.02.2014, 17:47   #4
Ship_1
Участник клуба
 
Регистрация: 10.02.2014
Сообщений: 523
Репутация: 60
По умолчанию (продолжение)

2.3. "Подгатавливаем почву" для переноса таблиц.
2.3.1. Для начала в открытой Вордовой таблице установим нужную высоту строки таблицы:
Код:

   MyWord.ActiveDocument.Tables.Item(1).Rows.Height:=28;

Как и всё остальное, высота строки в ворде измеряется в неких "пт". Экспериментальным путём я получил, что необходимые мне 10 мм. - это 28 пт. (хотя где-то в просторах интернета натыкался, что 1 пт - это 0.375 мм., но не совпало)
2.3.2. После этого введём переменные для обозначения номера создаваемой в ворде таблицы и номера последней перенесённой строки.
Код:

   NomP:=0;
   PredC:=0;

2.3.3. Начинаем перебирать. Первый уровень перебора - перечисленные в CheckListBox вкладки Экселя
Код:

   For NB:=0 to CheckListBox1.Count-1 do

2.3.4. Если вкладка отмечена - активируем в Экселе нужный лист
Код:

function ActivateSheet(WBIndex:integer; SheetName:string):boolean;
var i:integer;
begin
  Result:=false;
  try
    if WBIndex>MyExcel.WorkBooks.Count then
      raise Exception.Create('Задан неверный индекс для WorkBooks. Активация листа прервана')
    else
      begin
        for i:=1 to MyExcel.WorkBooks[WBIndex].Sheets.Count do
          if AnsiLowerCase(MyExcel.WorkBooks[WBIndex].Sheets.Item[i].Name)=AnsiLowerCase(SheetName) then
            begin
              MyExcel.WorkBooks[WBIndex].Sheets.Item[i].Activate;
              Result:=true;
              break;
            end;
      end;
  except
    raise Exception.Create('Активация листа завершена с ошибкой');
  end;
end;

2.3.5. И загружаем его содержимое
Код:

function GetDataCells(RangeArray:string):Variant;
var  val: Variant;
     Sheet: OLEVariant;
     i:integer;
begin
  Sheet:=MyExcel.ActiveWorkBook.ActiveSheet;
  Val:=Sheet.Range[RangeArray].Value;
  Form1.Memo1.Lines.Add('Количество колонок загруженных данных: '+IntToStr(Sheet.Range[RangeArray].Columns.Count));
  Form1.Memo1.Lines.Add('Количество строк загруженных данных: '+IntToStr(Sheet.Range[RangeArray].Rows.Count));
  Result:=Val;
end;

Это содержимое присваивается переменной
Код:

     LoadTableData:OLEVariant;

2.3.6. Получаем номер последней "используемой" ячейки таблицы на листе:
Код:

      TR:=MyExcel.ActiveWorkBook.ActiveSheet.UsedRange.Rows.Count;

И вот тут есть первый "подводный камень". Используемыми в Экселе считаются даже ячейки без содержимого, но хоть как-то моло мальски отформатированные (задана линия границы, или цвет ячейки, или даже она просто выделена - Эксель запоминает и это и считает ячейку используемой).
Чтоб не возиться с ненужными столбцами, случайно считающимися Экселем используемыми, я и задал жёсткую привязку числа колонок. А необрабатывание ненужных строк встроил в программу (будет дальше).
2.3.7. И запускаем второй уровень перебора - по строкам таблицы.
Код:

        For YC:=1 to TR do

Ship_1 вне форума   Ответить с цитированием
Старый 23.02.2014, 17:52   #5
Ship_1
Участник клуба
 
Регистрация: 10.02.2014
Сообщений: 523
Репутация: 60
По умолчанию (продолжение)

2.4. Приступаем непосредственно к переносу.
2.4.1. Добавляем новую строку.
Код:

MyWord.ActiveDocument.Tables.Item(NomP+1).Rows.Add(EmptyParam);

Работа происходит всегда с предпоследней строкой, т.к. если вдруг понадобится объединить ячейки - новая добавленная строка тоже будет с объединёнными ячейками. Поэтому работаем с предпоследней строкой, а последнюю оставляем с нужным нам количеством исходных столбцов.
2.4.2. Проверяем первую ячейку аналогичной строки активной вкладки Экселя наобъединённость, и, если она входит в объединённые
Код:

          if MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].MergeCells then

2.4.2.1. начинаем объединять соседние (по горизонтали) ячейки Ворда
Код:

MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Merge(MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,2));
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Merge(MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,2));
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Merge(MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,2));
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Merge(MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,2));

2.4.2.2. не забываем, что программа предусматривает возможность работы с шестью, а не с пятью, столбцами (поставив в CheckBox галочку о том, что нужно работать с шестью столбцами), но для этого нужен отдельный шаблон, в котором начальная строка таблицы содержит 5, а не 6, столбцов.
Код:

            try
              If CheckBox1.Checked then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Merge(MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,2));
            except
              ShowMessage('Ваш шаблон позволяет вставить только 5 колонок, а не 6.'+#13+'Если Вам нужно большее количество колонок - выберите другой шаблон.'+#13+'А пока работа продолжится с пятью колонками.');
              CheckBox1.Checked:=false;
            end;

2.4.2.3. и, т.к. это не строка данных, а заголовок или подзаголовок, начинаем переносить параметры форматирования текста и выравнивания ячейки:
Шрифт:
Код:

            If MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].Font.Bold then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Font.Bold:=1;
            If MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].Font.Italic then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Font.Italic:=1;
            If MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].Font.Underline then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Font.Underline:=1;

Внимание: глюк - почему-то она у меня все ячейки, затрагиваемые данной частью, считает подчёркнутыми. С жирным и курсивом всё впорядке. Хотя строки идиентичные. Не понял в чём дело...
Выравнивание:
Код:

            If MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].HorizontalAlignment = -4131 then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Paragraphs.Format.Alignment:=$00000000; // лево
            If MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].HorizontalAlignment = -4108 then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Paragraphs.Format.Alignment:=$00000001; // центр
            If MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].HorizontalAlignment = -4152 then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Paragraphs.Format.Alignment:=$00000002; // право
            If MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].VerticalAlignment = -4160 then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Cells.VerticalAlignment:=$00000000; // верх
            If MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].VerticalAlignment = -4108 then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Cells.VerticalAlignment:=$00000001; // центр
            If MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].VerticalAlignment = -4107 then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Cells.VerticalAlignment:=$00000003; // низ

2.4.2.4. И переносим содержимое
Код:

           MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Text:=LoadTableData[YC,1];

Ship_1 вне форума   Ответить с цитированием
Старый 23.02.2014, 17:57   #6
Ship_1
Участник клуба
 
Регистрация: 10.02.2014
Сообщений: 523
Репутация: 60
По умолчанию (продолжение)

2.4.3. Если же у нас строка не объединённая, значит она содержит обычные данные.
2.4.3.1. Применяем необходимое выравнивание ячейкам
Код:

MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Paragraphs.Format.Alignment:=$00000001;
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Cells.VerticalAlignment:=$00000001; // первая ячейка - центр/центр
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,2).Range.Paragraphs.Format.Alignment:=$00000000;
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,2).Range.Cells.VerticalAlignment:=$00000001; // вторая ячейка - лево/центр
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,3).Range.Paragraphs.Format.Alignment:=$00000001;
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,3).Range.Cells.VerticalAlignment:=$00000001; // третья ячейка - центр/центр
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,4).Range.Paragraphs.Format.Alignment:=$00000001;
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,4).Range.Cells.VerticalAlignment:=$00000001; // четвёртая ячейка - центр/центр
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,5).Range.Paragraphs.Format.Alignment:=$00000000;
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,5).Range.Cells.VerticalAlignment:=$00000001; // пятая ячейка - лево/центр

2.4.3.2. Не забываем, что у нас может быть шестиколоночный режим.
Код:

            try
              If CheckBox1.Checked then
              begin
                // если шесть колонок - пятая центр/центр, шестая лево/центр
                MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,5).Range.Paragraphs.Format.Alignment:=$00000001;
                MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,5).Range.Cells.VerticalAlignment:=$00000001;
                MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,6).Range.Paragraphs.Format.Alignment:=$00000000;
                MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,6).Range.Cells.VerticalAlignment:=$00000001;
              end;
            except
              ShowMessage('Ваш шаблон позволяет вставить только 5 колонок, а не 6.'+#13+'Если Вам нужно большее количество колонок - выберите другой шаблон.'+#13+'А пока работа продолжится с пятью колонками.');
              CheckBox1.Checked:=false;
              // колонок таки пять, поэтому - пятая лево/центр
              MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,5).Range.Paragraphs.Format.Alignment:=$00000000;
              MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,5).Range.Cells.VerticalAlignment:=$00000001;
            end;

2.4.3.3. Переносим значения (не забывая про возможный шестой столбец)
Код:

            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,1).Range.Text:=LoadTableData[YC,1];
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,2).Range.Text:=LoadTableData[YC,2];
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,3).Range.Text:=LoadTableData[YC,3];
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,4).Range.Text:=LoadTableData[YC,4];
            MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC,5).Range.Text:=LoadTableData[YC,5];
            try
              If CheckBox1.Checked then MyWord.ActiveDocument.Tables.Item(NomP+1).Cell({ATR+}YC,6).Range.Text:=LoadTableData[YC,6];
            except
              ShowMessage('Ваш шаблон позволяет вставить только 5 колонок, а не 6.'+#13+'Если Вам нужно большее количество колонок - выберите другой шаблон.'+#13+'А пока работа продолжится с пятью колонками.');
              CheckBox1.Checked:=false;
            end;

2.4.4. Увеличим на один номер последней перенесённой строки и проверяем не закончились лиданные в таблице.
Окончанием данных считаем не только конец используемого диапазона активной вкладки Экселя (по причине, описаной в п.2.3.6.), но и две пустые ячейки подряд во втором столбце
Код:

            PredC:=PredC+1;
            If (LoadTableData[YC,2]='') and (not MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC), EmptyParam].MergeCells) then
            try
              Form1.Memo1.Lines.Add('Найдена пустая строка '+IntToStr(YC)+' вкладки '+MyExcel.ActiveWorkBook.ActiveSheet.Name);
              If not MyExcel.ActiveWorkBook.ActiveSheet.Range['A'+IntToStr(YC+1), EmptyParam].MergeCells then
                If LoadTableData[YC+1,2]='' then Break;
            except
              Form1.Memo1.Lines.Add('Конец данных таблицы, строка '+IntToStr(YC)+' вкладки '+MyExcel.ActiveWorkBook.ActiveSheet.Name);
              Break;
            end;

Т.к. в объединённых ячейках второго столбца не существует (вся ячейка становится первой), вставляем это именно в обработчик части для не объединённых ячеек.
Ship_1 вне форума   Ответить с цитированием
Старый 23.02.2014, 18:04   #7
Ship_1
Участник клуба
 
Регистрация: 10.02.2014
Сообщений: 523
Репутация: 60
По умолчанию (окончание)

2.4.5. Это был конец второго уровня перебора, начатый в п.2.3.7. После его выполнения перенос данных с одной вкладки будет закончен.
2.4.6. Т.к. каждая новая вкладка должна начинаться с нового листа - делаем разрыв.
Я пробовал экспериментировать с разрывом страницы, чтобы не было заморочек с колонтитулами, т.к. для каждого нового раздела свои условия или копия предыдущих, что в любом случае не здорово, т.к. появляется дополнительная зона отслеживания. Но в какую бы ячейку я вручную не вставлял разрыв страницы - всегда на новой странице появлялась сначала пустая текстовая строка, а потом продолжалась таблица. Это совсем не подходит для моей задачи, т.к. "шапка" таблицы у меня в колонтитулах, и таблица должна начинаться сразу после конца колонтитулов.
С этой задачей справилась вставка нового раздела.
Код:

MyWord.ActiveDocument.Tables.Item(NomP+1).Cell(YC+PredC+1,1).Range.InsertBreak($00000002); // новый раздел с нового листа

Что-то тут, возможно, лишнее, но таки работает... Дальнейший разбор и расчистка ещё предстоит.
2.4.7. После этого обнуляем переменную последней перенесённой строки таблицы и увеличиваем на одну переменную номера создаваемой таблицы.
Код:

              NomP:=NomP+1;
              PredC:=0;

2.4.8. Это конец первого уровня перебора, начатый в п. 2.3.3. После его прохождения будут перенесены все нужные вкладки и задача будет выполнена.
2.5. Теперь можно закрыть Ворд (примерно так же, какЭксель в п.1.6, 1.7.)
С одной лишь разницей: сам Ворд мы не закрываем, а оставляем открытым для работы с полученным результатом.
Код:

function StopWord:boolean;
begin
  try
    if not MyWord.Visible then MyWord.Visible:=true;
    MyWord:=Unassigned;
    Result:=True;
  except
    Result:=false;
  end;
end;

Код:

// ======== закрытие Ворда ===========
  if OpWdState=0 then
  begin
     if CheckWordInstall then  // Объект найден
    Begin
      if CheckWordRun then  // Объект запущен
      Begin
        if StopWord then Form1.Memo1.Lines.Add('Загрузка данных прошла успешно; MS Word закрыт.')
                     else Form1.Memo1.Lines.Add('Возникли проблемы при закрытии Ворда.');
      End
      else
        Form1.Memo1.Lines.Add('MS Word не был запущен')
    End
    else
      Form1.Memo1.Lines.Add('MS Word не установлен.')
  end
  else
  begin
    Form1.Memo1.Lines.Add('Возникла ошибка открытия файла Ворд номер '+IntToStr(OpExState));
  end;
// ======== конец закрытия Ворда ===========

2.6. И закрыть Эксель в точности, как в п.1.6, 1.7.


На этом пока всё.

Жаль, здесь потом нельзя будет отредактировать эту запись. Сделал бы покрасивее...
Надеюсь, сделал эту запись на пользу обществу, а не во вред (учитывая объём)
Программа пока сырая. Буду дальше разбирать.
Если кто знает - три наиболее интересующих меня сейчас вопроса:
1. Как задать смещение таблицы в Ворде относительно верха и лева листа?
2. Как программно сделать в новом разделе другие колонтитулы (т.е. убрать значение "как в предыдущем разделе).
3. Можно ли скопировать таблицу в Ворде из одного места в другой целиком (проще, чем нарисовать заново с такими же параметрами)?

Присутствующая недоработка: изначальную строку, после выполнения всех циклов, программа переносит в новый раздел. В результате в конце появляется всегда один лист с одной строкой.

Во вложении юнит целиком.
Вложения
Тип файла: rar Unit1.rar (3.9 Кб, 69 просмотров)

Последний раз редактировалось Ship_1; 23.02.2014 в 18:42.
Ship_1 вне форума   Ответить с цитированием
Старый 02.03.2014, 20:43   #8
Ship_1
Участник клуба
 
Регистрация: 10.02.2014
Сообщений: 523
Репутация: 60
По умолчанию

Хм... Вопросы без ответа, тема без сообщений... Зря писал?
Ship_1 вне форума   Ответить с цитированием
Старый 04.04.2016, 14:42   #9
HelpForDiplom
Новичок
 
Регистрация: 04.04.2016
Сообщений: 1
Репутация: 10
По умолчанию

Спасибо большое))
HelpForDiplom вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Постоянно слетает галочка "автоматически" в "Параметры Excel", "Формулы", "Вычисления в книге" Alexsandrr Microsoft Office Excel 4 19.10.2013 14:22
Суммирование значений "детальной" таблицы JUDAS SQL, базы данных 2 13.10.2011 14:32
Связь автофигуры "Надпись" в Word со значением ячейки в Excel. OMEN_6666 Microsoft Office Excel 2 24.12.2010 21:43
Поиск "проблемных значений" и вставка строки в новый документ Excel Gvaridos Microsoft Office Excel 5 16.11.2010 14:56
Автоматическое сохранение + Печать. Продолжение темы "Перенос данных из Excel в Word" The_Andrei Microsoft Office Word 15 23.06.2009 23:46


09:53.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru