Макрос

Автор Vedutenko, июня 05, 2017, 02:08:00 pm

« предыдущая - следующая »

Vedutenko

июня 05, 2017, 02:08:00 pm Последнее редактирование: июня 05, 2017, 03:00:57 pm от Vedutenko
Извините за тему, решил проблему. Спасибо!

admin

 :)
Думаю, многим будет интересно, как?

Vedutenko

sub exportReportToExcel
Set QvDoc = ActiveDocument
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible =  true
objExcelApp.DisplayAlerts = false
dim qvObjectId
Set objExcelDoc =  objExcelApp.Workbooks.Add


objExcelDoc.Sheets(1).Name="Табличные данные"
'objExcelDoc.Sheets.Add()
objExcelDoc.Sheets(2).Delete
objExcelDoc.Sheets(2).Delete
'objExcelDoc.Sheets(2).Delete
'objExcelDoc.Sheets(1).Name="Лист с графиками"

set objExcelSheet=objExcelDoc.Sheets(1)

objExcelSheet.Select

set objSource = QvDoc.GetSheetObject("CH01")

   Call objSource.GetSheet().Activate()
   Set objCurrentSheet = objExcelDoc.Sheets("Табличные данные")
   'QvDoc.GetApplication.WaitForIdle
   'ActiveDocument.Fields("ТипПлана").Select "Ежемесячный"   
   'ActiveDocument.Fields("Квартал_ПФ").Select ""   
   Call objSource.CopyTableToClipboard(true)
                                                                                                                                             '   Set objCurrentSheet = objExcelDoc.Sheets("Лист с данными")
      objCurrentSheet.Range("A2").Select
      objExcelDoc.Sheets("Табличные данные").Paste
     
set objExcelSheet=objExcelDoc.Sheets(1)

objExcelSheet.Select

set objSource = QvDoc.GetSheetObject("CH01")


 
     
   '   objExcelDoc.Sheets("Табличные данные").Range("A2:F2").WrapText = True
      objExcelDoc.Sheets("Табличные данные").Range("A:A").ColumnWidth = 15
  '     Columns("A:A").Select
  '  Selection.ColumnWidth = 15
  '    set  inter= objExcelDoc.Sheets("Табличные данные").Range("A1:F1")
  '    inter.interior.Color = 15263976
  '    inter.FormulaR1C1 = "Выполнение ежемесячного плана продаж 2017"
  '    inter.Merge
     
     
   '   objExcelDoc.Sheets("Табличные данные").Columns("A:M").ColumnWidth = 10.14


' objExcelDoc.SaveAs "C:\Users\Vedutenko\Desktop\таблицы\test.xlsx"     
 
end sub



Рейтинг@Mail.ru Яндекс.Метрика