Excel не работает application quit

Эксель не закрывается с кодом Application.Quit

Sobirjon

Дата: Понедельник, 09.03.2020, 14:56 |
Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 151


Репутация:

2

±

Замечаний:
0% ±


2016

Доброго времени суток, уважаемые формучане!
Собственно проблема отражена в названии темы, файл примера прицепил.
Буду признателен за помощь

К сообщению приложен файл:

8801346.xlsb
(13.1 Kb)

 

Ответить

Roman777

Дата: Понедельник, 09.03.2020, 16:24 |
Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980


Репутация:

127

±

Замечаний:
0% ±


Excel 2007, Excel 2013

Sobirjon, Добрый день! рекомендую Вам поставить бейкпойнт и проверить чему у вас равно кол-во книг в момент закрытия. У меня число книг всегда больше 1, поскольку есть книга личных макросов.
Ещё мне странным кажется, что код работает нормально при вашей записи, но я бы, всё-таки, сначала закрывал книгу и только потом бы закрывал приложение, а не наоборот.


Много чего не знаю!!!!

Сообщение отредактировал Roman777Понедельник, 09.03.2020, 16:25

 

Ответить

Sobirjon

Дата: Вторник, 10.03.2020, 04:09 |
Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 151


Репутация:

2

±

Замечаний:
0% ±


2016

чему у вас равно кол-во книг

Задача выйти полностью из эксель, если нет больше открытых книг.
Перед обращением естественно смотрел в отладчике по шагово.
Условие выполняется, макрос заходит, только по не понятным мне причинам эксель не выходит :help:

сначала закрывал книгу и только потом бы закрывал приложение

Этого не пробовал. Сейчас проверил, не помог

 

Ответить

K-SerJC

Дата: Вторник, 10.03.2020, 09:27 |
Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 487


Репутация:

86

±

Замечаний:
0% ±


Excel 2013

Доброго дня!
у меня работает так:


Благими намерениями выстелена дорога в АД.

 

Ответить

Sobirjon

Дата: Вторник, 10.03.2020, 14:21 |
Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 151


Репутация:

2

±

Замечаний:
0% ±


2016

K-SerJC
[vba][/vba]завершает макрос, но приложение остается по прежнему.

Протестировал вот так:
[vba]

Код

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    With Application
        .DisplayFullScreen = False
        .DisplayFormulaBar = True
        .DisplayAlerts = False
    End With

    ‘    ActiveWorkbook.Close True
‘    Application.Quit
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.DisplayAlerts = False
    Cancel = True
End Sub

Private Sub Workbook_Open()
    Application.DisplayFullScreen = True
End Sub

[/vba]
Приложение закрывается и книга не сохранятся (как и планировался) если больше открытых книг нет.
Если открыто еще книги, тогда на сообщению которые вылетает с запросом о сохранении книги нажать «сохранить», то запрос занового повторяется пока не нажать «не сохранить».
почему-то [vba]

Код

Application.DisplayAlerts = False

[/vba] игнорируется

Сообщение отредактировал SobirjonВторник, 10.03.2020, 14:22

 

Ответить

K-SerJC

Дата: Среда, 11.03.2020, 12:59 |
Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 487


Репутация:

86

±

Замечаний:
0% ±


Excel 2013

а так?

событие Workbook_BeforeClose запускается когда вы уже закрываете эту книгу
еще раз в нем вызывать закрытие книги не требуется
это будет выполнено по завершению этой процедуры.

переменная trt чтобы повторно событие не запустилось.


Благими намерениями выстелена дорога в АД.

Сообщение отредактировал K-SerJCСреда, 11.03.2020, 13:04

 

Ответить

Sobirjon

Дата: Четверг, 12.03.2020, 07:02 |
Сообщение № 7

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 151


Репутация:

2

±

Замечаний:
0% ±


2016


Огонь respect
Только не могу понять почему при
[vba]

Код

ThisWorkbook.Saved = True

[/vba]
Книга не сохраняется, в чем магия?

Сообщение отредактировал SobirjonЧетверг, 12.03.2020, 07:09

 

Ответить

Sobirjon

Дата: Четверг, 12.03.2020, 11:35 |
Сообщение № 8

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 151


Репутация:

2

±

Замечаний:
0% ±


2016

Книга не сохраняется, в чем магия?

Нашел в справке deal
Этот как раз то что было мне нужно hands Спасибо, еще раз

 

Ответить

When Application.Quit is encountered in a subroutine,
it will only stay in memory and continue to run lines under it
and will actually quit until it encounters a «Exit Sub».
When the normal «End Sub» at the primary level is encountered,
it will then also close Excel. But say if the workbook is somehow
closed before reaching the «Exit Sub», «End» or «End Sub» line, then
Excel will not close.

Solution is to create a Public variable called ToQuitNow
with initial False value
and change it to True where you want Excel to quit.
and test right after to see if it is true, then return to previous Sub level
by «Exit Sub» or «End» to quit right away,
and do the same at every subrountine level where
it is expected to return from the deeper subroutine.
When it gets back to the primary level,
then a final «Exit Sub» will actually terminates Excel.
If you do not want Excel to ask for saving changes made,
add line «ThisWorkbook.Saved = True» right after Application.Quit,
or before the final «Exit Sub» at the Primary level
and Excel will quit without saving.

Try the following test below, just run «Test»

Public ToQuitNow As Boolean

Sub Test()

ToQuitNow = False ' initialize with False value
Call SecondSub
MsgBox ("Primary level here. Back from SecondSub")
If ToQuitNow = True Then
    Exit Sub 'will actually quit Excel now if True
End If
MsgBox ("This line will not run if ToQuitNow is True")
End Sub

Sub SecondSub()

MsgBox ("SecondSub here")
Call ThirdSub
MsgBox ("SecondSub here. Back from ThirdSub")
If ToQuitNow = True Then
    Exit Sub ' will return to Main level if True
End If
MsgBox ("This line from SecondSub will not run if ToQuitNow is True")
End Sub

Sub ThirdSub()

MsgBox ("ThirdSub here")
Call FourthSub
MsgBox ("ThirdSub here. Back from FourthSub")
If ToQuitNow = True Then
    Exit Sub ' will return to SecondSub if True
End If
MsgBox ("This line from ThirdSub will not run if ToQuitNow is True")
End Sub

Sub FourthSub()

MsgBox ("FourthSub here")
Application.Quit
ThisWorkbook.Saved = True ' Excel will think changes already saved _
and will quit without saving
ToQuitNow = True ' activate Quit
If ToQuitNow = True Then
    MsgBox ("Quit command executed in FourthSub")
    Exit Sub ' will return to ThirdSub if True
    'Can also put in End in above line to quit right away

End If
MsgBox ("This line from FourthSub will not run if ToQuitNow is True.")
End Sub

Содержание

  1. Excel не завершает работу после вызова метода Quit при автоматизации из JScript
  2. Симптомы
  3. Причина
  4. Решение
  5. Состояние
  6. Шаги для воспроизведения
  7. Ссылки
  8. Excel Application.Quit не убивает процесс EXECL.EXE
  9. Excel не работает application quit

Excel не завершает работу после вызова метода Quit при автоматизации из JScript

Симптомы

При автоматизации Microsoft Excel из Microsoft JScript Excel остается в памяти после вызова метода Quit, пока вы не закроете Internet Explorer или не перейдете на другую страницу.

Причина

JScript удерживает ссылку на Excel. Так как при выполнении команды «Выйти» в Excel есть ссылка, Excel не завершает работу. JScript — это язык сборки мусора, то есть подсистема очищается после себя в определенный момент, а не при задании переменным значения NULL. При завершении работы Internet Explorer или переходе на другую страницу подсистема уничтожается. Это приводит к принудительной сборке мусора и освобождает ссылку на Excel.

Решение

Чтобы обойти эту проблему, можно вызвать метод CollectGarbage. Это приводит к немедленной сборке мусора JScript, которая освобождает ссылку на Excel. В следующем фрагменте кода показано, как использовать метод CollectGarbage:

Обратите внимание, что метод CollectGarbage не вызывается непосредственно после метода Quit в Excel. Перед вызовом CollectGarbage необходимо предоставить JScript небольшой промежуток времени. В этом примере таймер используется для отображения краткого ожидания перед принудительной сборкой мусора.

Другим решением является использование VBScript для автоматизации Microsoft Excel. В отличие от JScript, VBScript не является языком сборки мусора. Таким образом, ссылки выпускаются при установке для переменных значения Nothing. С помощью VBScript Excel завершает работу сразу после вызова метода Quit и освобождения переменных. Дополнительные сведения см. в разделе «Ссылки «.

Недокументированный метод CollectGarbage не является частью спецификации ECMA-262 и может быть недоступен в будущих версиях обработчика скриптов. При принудительном запуске сборщика мусора путем вызова CollectGarbage это также может негативно сказаться на производительности.

Состояние

Корпорация Майкрософт подтвердила, что это ошибка в продуктах Майкрософт, перечисленных в начале этой статьи.

Шаги для воспроизведения

Запустите Блокнот и вставьте в редактор следующий код:

Сохраните файл как JScriptTest.HTM и закройте Блокнот.

Дважды щелкните файл JScriptTest.HTM, чтобы загрузить его в Internet Explorer.

Запустите диспетчер задач Windows.

Нажмите кнопку «Автоматизировать Excel» на веб-странице в Internet Explorer. Изучите диспетчер задач Windows и обратите внимание, что Excel запускается и остается в памяти.

Перейдите на другую страницу или закройте Internet Explorer. Обратите внимание, что Excel завершает работу и больше не отображается в диспетчере задач Windows.

Ссылки

Дополнительные сведения о примере кода VBScript, демонстрирующий автоматизацию в Excel, см. в статье об автоматизации Excel с помощью клиентского VBScript.

Источник

Excel Application.Quit не убивает процесс EXECL.EXE

Ive идентифицировал странное поведение с командой Excels Quit что я не могу найти объяснение или решение.

Сценарий VBScript ниже реплицирует проблему. Вот что он делает…

  1. Создает новый экземпляр Excel
  2. Открывает и закрывает определенное количество книг (контролируемых WorkbooksToCreate )
  3. Попытки выйти Quit Excel
  4. И тогда это доказывает, действительно ли Excel действительно ушел, изменив состояние Visible на True

То, что Ive собрало, состоит в том, что успешное Quit происходит только тогда, когда WorkbooksToCreate установлен в 0 или 1. Если установлено значение 2 или выше, Excel не будет нормально работать.

Я использую Excel 2010 в Windows 7.

Ive попробовал множество вариаций по этому вопросу, но не мог решить, в чем проблема. Лучше всего я могу сказать, что все xlApp.Quit в этом случае эквивалентно xlApp.Visible = False

Заинтересованы, хотите ли вы от вас, ребята, удачи или кто-то заметил подобное поведение с Excel?

+1 для @omegastripes и @Mikegrann для определения этого не происходит на каждой машине.

Ive исследовал дальше и нашел, что проблема связана с моим собственным рабочим ноутбуком. Проблема не может быть воспроизведена на других машинах.

Но я успешно проследил и исправил ошибку. Это было вызвано одним конкретным надстройкой COM под названием CiscoClickToCall.Connect . Как только это было удалено, скрипт начал вести себя так, как ожидалось, и успешно завершил работу.

Я, вероятно, не должен был полностью удалить его из Windows; этого было бы достаточно, чтобы просто удалить надстройку из Excel, но это приложение, для которого я не использую, поэтому я просто избавился от него.

Из того, что я мог сказать, что все надстройки были предназначены, заключались в том, чтобы добавлять контекстные меню в ячейки правой кнопкой мыши.

Источник

Excel не работает application quit

Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Эксель не закрывается с кодом Application.Quit (Макросы/Sub)

Эксель не закрывается с кодом Application.Quit

Sobirjon Дата: Понедельник, 09.03.2020, 14:56 | Сообщение № 1
Roman777 Дата: Понедельник, 09.03.2020, 16:24 | Сообщение № 2

Много чего не знаю.

Sobirjon Дата: Вторник, 10.03.2020, 04:09 | Сообщение № 3
K-SerJC Дата: Вторник, 10.03.2020, 09:27 | Сообщение № 4

Option Explicit
Public trt As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If trt Then Exit Sub
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
trt = True
If Workbooks.Count = 1 Then
ThisWorkbook.Saved = True
Application.Quit
ThisWorkbook.Close False
Else
If Workbooks.Count = 2 Then
If Workbooks(1).Name = «PERSONAL.XLSB» Or Workbooks(2).Name = «PERSONAL.XLSB» Then
Workbooks(«PERSONAL.XLSB»).Close False
ThisWorkbook.Saved = True
Application.Quit
trt = False
End If
Else
ThisWorkbook.Close False
End If
End If
End Sub

Option Explicit
Public trt As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If trt Then Exit Sub
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
trt = True
If Workbooks.Count = 1 Then
ThisWorkbook.Saved = True
Application.Quit
ThisWorkbook.Close False
Else
If Workbooks.Count = 2 Then
If Workbooks(1).Name = «PERSONAL.XLSB» Or Workbooks(2).Name = «PERSONAL.XLSB» Then
Workbooks(«PERSONAL.XLSB»).Close False
ThisWorkbook.Saved = True
Application.Quit
trt = False
End If
Else
ThisWorkbook.Close False
End If
End If
End Sub

Благими намерениями выстелена дорога в АД.

Ответить

Option Explicit
Public trt As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If trt Then Exit Sub
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
trt = True
If Workbooks.Count = 1 Then
ThisWorkbook.Saved = True
Application.Quit
ThisWorkbook.Close False
Else
If Workbooks.Count = 2 Then
If Workbooks(1).Name = «PERSONAL.XLSB» Or Workbooks(2).Name = «PERSONAL.XLSB» Then
Workbooks(«PERSONAL.XLSB»).Close False
ThisWorkbook.Saved = True
Application.Quit
trt = False
End If
Else
ThisWorkbook.Close False
End If
End If
End Sub

Sobirjon Дата: Вторник, 10.03.2020, 14:21 | Сообщение № 5

[/vba]завершает макрос, но приложение остается по прежнему.

Протестировал вот так:
[vba]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
.DisplayFullScreen = False
.DisplayFormulaBar = True
.DisplayAlerts = False
End With

‘ ActiveWorkbook.Close True
‘ Application.Quit
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
Cancel = True
End Sub

Private Sub Workbook_Open()
Application.DisplayFullScreen = True
End Sub

[/vba]завершает макрос, но приложение остается по прежнему.

Протестировал вот так:
[vba]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
.DisplayFullScreen = False
.DisplayFormulaBar = True
.DisplayAlerts = False
End With

‘ ActiveWorkbook.Close True
‘ Application.Quit
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
Cancel = True
End Sub

Private Sub Workbook_Open()
Application.DisplayFullScreen = True
End Sub

[/vba]завершает макрос, но приложение остается по прежнему.

Протестировал вот так:
[vba]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
.DisplayFullScreen = False
.DisplayFormulaBar = True
.DisplayAlerts = False
End With

‘ ActiveWorkbook.Close True
‘ Application.Quit
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
Cancel = True
End Sub

Private Sub Workbook_Open()
Application.DisplayFullScreen = True
End Sub

K-SerJC Дата: Среда, 11.03.2020, 12:59 | Сообщение № 6

Option Explicit
Public trt As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If trt Then trt = False: Cancel = True: Exit Sub
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
trt = True
If Workbooks.Count = 1 Then
ThisWorkbook.Saved = True
Application.Quit
Else
If Workbooks.Count = 2 Then
If Workbooks(1).Name = «PERSONAL.XLSB» Or Workbooks(2).Name = «PERSONAL.XLSB» Then
Workbooks(«PERSONAL.XLSB»).Close False
ThisWorkbook.Saved = True
Application.Quit
trt = False
End If
Else
End If
End If
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
Application.DisplayFullScreen = True
End Sub

событие Workbook_BeforeClose запускается когда вы уже закрываете эту книгу
еще раз в нем вызывать закрытие книги не требуется
это будет выполнено по завершению этой процедуры.

переменная trt чтобы повторно событие не запустилось.

Option Explicit
Public trt As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If trt Then trt = False: Cancel = True: Exit Sub
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
trt = True
If Workbooks.Count = 1 Then
ThisWorkbook.Saved = True
Application.Quit
Else
If Workbooks.Count = 2 Then
If Workbooks(1).Name = «PERSONAL.XLSB» Or Workbooks(2).Name = «PERSONAL.XLSB» Then
Workbooks(«PERSONAL.XLSB»).Close False
ThisWorkbook.Saved = True
Application.Quit
trt = False
End If
Else
End If
End If
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
Application.DisplayFullScreen = True
End Sub

событие Workbook_BeforeClose запускается когда вы уже закрываете эту книгу
еще раз в нем вызывать закрытие книги не требуется
это будет выполнено по завершению этой процедуры.

переменная trt чтобы повторно событие не запустилось. K-SerJC

Благими намерениями выстелена дорога в АД.

Сообщение а так?

Option Explicit
Public trt As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If trt Then trt = False: Cancel = True: Exit Sub
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
trt = True
If Workbooks.Count = 1 Then
ThisWorkbook.Saved = True
Application.Quit
Else
If Workbooks.Count = 2 Then
If Workbooks(1).Name = «PERSONAL.XLSB» Or Workbooks(2).Name = «PERSONAL.XLSB» Then
Workbooks(«PERSONAL.XLSB»).Close False
ThisWorkbook.Saved = True
Application.Quit
trt = False
End If
Else
End If
End If
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
Application.DisplayFullScreen = True
End Sub

событие Workbook_BeforeClose запускается когда вы уже закрываете эту книгу
еще раз в нем вызывать закрытие книги не требуется
это будет выполнено по завершению этой процедуры.

переменная trt чтобы повторно событие не запустилось. Автор — K-SerJC
Дата добавления — 11.03.2020 в 12:59

Источник

Adblock
detector

Когда Application.Quit встречается в подпрограмме, он остается только в памяти и продолжает выполнять строки под ним и фактически завершает работу до тех пор, пока не встретит «Exit Sub». Когда встречается обычный «End Sub» на основном уровне, он также закрывает Excel. Но скажем, если рабочая книга каким-то образом закрывается до достижения строки «Exit Sub», «End» или «End Sub», Excel не закроется.

Решение состоит в том, чтобы создать общедоступную переменную с именем ToQuitNow с начальным значением False и изменить ее на True там, где вы хотите закрыть Excel. и проверьте сразу после этого, чтобы убедиться, что это правда, затем вернитесь на предыдущий подуровень с помощью «Exit Sub» или «End», чтобы выйти сразу, и сделайте то же самое на каждом уровне подпрограммы, где ожидается возврат из более глубокой подпрограммы. Когда он вернется на основной уровень, последний «Exit Sub» фактически закроет Excel. Если вы не хотите, чтобы Excel запрашивал сохранение внесенных изменений, добавьте строку «ThisWorkbook.Saved = True» сразу после Application.Quit или перед последним «Exit Sub» на начальном уровне, и Excel завершит работу без сохранения.

Попробуйте следующий тест ниже, просто запустите «Тест»

      Public ToQuitNow As Boolean

Sub Test()

ToQuitNow = False ' initialize with False value
Call SecondSub
MsgBox ("Primary level here. Back from SecondSub")
If ToQuitNow = True Then
    Exit Sub 'will actually quit Excel now if True
End If
MsgBox ("This line will not run if ToQuitNow is True")
End Sub

Sub SecondSub()

MsgBox ("SecondSub here")
Call ThirdSub
MsgBox ("SecondSub here. Back from ThirdSub")
If ToQuitNow = True Then
    Exit Sub ' will return to Main level if True
End If
MsgBox ("This line from SecondSub will not run if ToQuitNow is True")
End Sub

Sub ThirdSub()

MsgBox ("ThirdSub here")
Call FourthSub
MsgBox ("ThirdSub here. Back from FourthSub")
If ToQuitNow = True Then
    Exit Sub ' will return to SecondSub if True
End If
MsgBox ("This line from ThirdSub will not run if ToQuitNow is True")
End Sub

Sub FourthSub()

MsgBox ("FourthSub here")
Application.Quit
ThisWorkbook.Saved = True ' Excel will think changes already saved _
and will quit without saving
ToQuitNow = True ' activate Quit
If ToQuitNow = True Then
    MsgBox ("Quit command executed in FourthSub")
    Exit Sub ' will return to ThirdSub if True
    'Can also put in End in above line to quit right away

End If
MsgBox ("This line from FourthSub will not run if ToQuitNow is True.")
End Sub

I have a small problem that I can’t seem to figure out. I am saving a DataGridView (it’s contents) to an xls file. I have no problem in doing so except in my task manager its still showing up that it’s running. I have called:

  xlApp.Application.Quit() 

This is declared as:

  Dim xlApp As New excel.Application

This seems to not work, BUT this is the same way I quit when I let the user choose to export it to a Word Document. Im not sure where I am going wrong…

Here is my complete code

Imports Word = Microsoft.Office.Interop.Word
 Imports Excel = Microsoft.Office.Interop.Excel

 Public Class Form1

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    For x As Integer = 1 To 3500
        DataGridView1.Rows.Add(New Object() {"r" & x.ToString & "c1", "r" & x.ToString & "c2", "r" & x.ToString & "c3", "r" & x.ToString & "c4", "r" & x.ToString & "c5"})
    Next
End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
    exportToWord (DataGridView1)
End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Dim xlApp As New Excel.Application
    Dim xlWorkBook As Excel.Workbook
    Dim xlWorkSheet As Excel.Worksheet
    'Dim misValue As Object = System.Reflection.Missing.Value


    xlWorkBook = xlApp.Workbooks.Add
    xlWorkSheet = DirectCast(xlWorkBook.Sheets("sheet1"), Excel.Worksheet)

    xlApp.Visible = True

    Dim headers = (From ch In DataGridView1.Columns _
                  Let header = DirectCast(DirectCast(ch, DataGridViewColumn).HeaderCell, DataGridViewColumnHeaderCell) _
                  Select header.Value).ToArray()
    Dim headerText() As String = Array.ConvertAll(headers, Function(v) v.ToString)

    Dim items() = (From r In DataGridView1.Rows _
          Let row = DirectCast(r, DataGridViewRow) _
          Where Not row.IsNewRow _
          Select (From cell In row.Cells _
              Let c = DirectCast(cell, DataGridViewCell) _
              Select c.Value).ToArray()).ToArray()

    Dim table As String = String.Join(vbTab, headerText) & Environment.NewLine
    For Each a In items
        Dim t() As String = Array.ConvertAll(a, Function(v) v.ToString)
        table &= String.Join(vbTab, t) & Environment.NewLine
    Next
    table = table.TrimEnd(CChar(Environment.NewLine))
    Clipboard.SetText (table)

    Dim alphabet() As Char = "abcdefghijklmnopqrstuvwxyz".ToUpper.ToCharArray

    Dim range As excel.Range = xlWorkSheet.Range("B2:" & alphabet(headerText.Length) & (items.Length + 2).ToString)

    range.Select()
    xlWorkSheet.Paste()

    range.Borders(Excel.XlBordersIndex.xlDiagonalDown).LineStyle = Excel.XlLineStyle.xlLineStyleNone
    range.Borders(Excel.XlBordersIndex.xlDiagonalUp).LineStyle = Excel.XlLineStyle.xlLineStyleNone
    With range.Borders(Excel.XlBordersIndex.xlEdgeLeft)
        .LineStyle = Excel.XlLineStyle.xlContinuous
        .ColorIndex = 1 'black
        .TintAndShade = 0
        .Weight = Excel.XlBorderWeight.xlMedium
    End With
    With range.Borders(Excel.XlBordersIndex.xlEdgeTop)
        .LineStyle = Excel.XlLineStyle.xlContinuous
        .ColorIndex = 1 'black
        .TintAndShade = 0
        .Weight = Excel.XlBorderWeight.xlMedium
    End With
    With range.Borders(Excel.XlBordersIndex.xlEdgeBottom)
        .LineStyle = Excel.XlLineStyle.xlContinuous
        .ColorIndex = 1 'black
        .TintAndShade = 0
        .Weight = Excel.XlBorderWeight.xlMedium
    End With
    With range.Borders(Excel.XlBordersIndex.xlEdgeRight)
        .LineStyle = Excel.XlLineStyle.xlContinuous
        .ColorIndex = 1 'black
        .TintAndShade = 0
        .Weight = Excel.XlBorderWeight.xlMedium
    End With
    With range.Borders(Excel.XlBordersIndex.xlInsideVertical)
        .LineStyle = Excel.XlLineStyle.xlContinuous
        .ColorIndex = 1 'black
        .TintAndShade = 0
        .Weight = Excel.XlBorderWeight.xlThin
    End With
    With range.Borders(Excel.XlBordersIndex.xlInsideHorizontal)
        .LineStyle = Excel.XlLineStyle.xlContinuous
        .ColorIndex = 1 'black
        .TintAndShade = 0
        .Weight = Excel.XlBorderWeight.xlThin
    End With

    'xlApp.Visible = True

    xlWorkBook.SaveAs("C:UsersCoDeXeRDesktopWord1.xls", True)
    xlWorkBook.Close()
    xlApp.Application.Quit()

    ReleaseObject(xlWorkSheet) '<~~~ Added as per comment from deleted post
    ReleaseObject (xlWorkBook)
    ReleaseObject (xlApp)


End Sub

Public Sub exportToWord(ByVal dgv As DataGridView)
    ' Create Word Application
    Dim oWord As Word.Application = DirectCast(CreateObject("Word.Application"), Word.Application)

    ' Create new word document
    Dim oDoc As Word.Document = oWord.Documents.Add()


    Dim headers = (From ch In dgv.Columns _
                  Let header = DirectCast(DirectCast(ch, DataGridViewColumn).HeaderCell, DataGridViewColumnHeaderCell) _
                  Select header.Value).ToArray()
    Dim headerText() As String = Array.ConvertAll(headers, Function(v) v.ToString)

    Dim items() = (From r In dgv.Rows _
          Let row = DirectCast(r, DataGridViewRow) _
          Where Not row.IsNewRow _
          Select (From cell In row.Cells _
              Let c = DirectCast(cell, DataGridViewCell) _
              Select c.Value).ToArray()).ToArray()

    Dim table As String = String.Join(vbTab, headerText) & Environment.NewLine
    For Each a In items
        Dim t() As String = Array.ConvertAll(a, Function(v) v.ToString)
        table &= String.Join(vbTab, t) & Environment.NewLine
    Next
    table = table.TrimEnd(CChar(Environment.NewLine))
    Clipboard.SetText (table)

    Dim oTable As Word.Table = oDoc.Tables.Add(oDoc.Bookmarks.Item("endofdoc").Range, items.Count + 1, headers.Count)

    oTable.Range.Paste()

    'make the first row bold, fs 14 + change textcolor
    oTable.Rows.Item(1).range.Font.Bold = &H98967E
    oTable.Rows.Item(1).range.Font.Size = 14
    oTable.Rows.Item(1).range.Font.Color = Word.WdColor.wdColorWhite

    'change backcolor of first row
    oTable.Rows.Item(1).range.Shading.Texture = Word.WdTextureIndex.wdTextureNone
    oTable.Rows.Item(1).range.Shading.ForegroundPatternColor = Word.WdColor.wdColorAutomatic
    oTable.Rows.Item(1).range.Shading.BackgroundPatternColor = Word.WdColor.wdColorLightBlue

    ''set table borders
    'With oTable.Range.Tables(1)
    '    With .Borders(Word.WdBorderType.wdBorderLeft)
    '        .LineStyle = Word.WdLineStyle.wdLineStyleSingle
    '        .LineWidth = Word.WdLineWidth.wdLineWidth100pt
    '        .Color = Word.WdColor.wdColorAutomatic
    '    End With
    '    With .Borders(Word.WdBorderType.wdBorderRight)
    '        .LineStyle = Word.WdLineStyle.wdLineStyleSingle
    '        .LineWidth = Word.WdLineWidth.wdLineWidth100pt
    '        .Color = Word.WdColor.wdColorAutomatic
    '    End With
    '    With .Borders(Word.WdBorderType.wdBorderTop)
    '        .LineStyle = Word.WdLineStyle.wdLineStyleSingle
    '        .LineWidth = Word.WdLineWidth.wdLineWidth100pt
    '        .Color = Word.WdColor.wdColorAutomatic
    '    End With
    '    With .Borders(Word.WdBorderType.wdBorderBottom)
    '        .LineStyle = Word.WdLineStyle.wdLineStyleSingle
    '        .LineWidth = Word.WdLineWidth.wdLineWidth100pt
    '        .Color = Word.WdColor.wdColorAutomatic
    '    End With
    '    With .Borders(Word.WdBorderType.wdBorderHorizontal)
    '        .LineStyle = Word.WdLineStyle.wdLineStyleSingle
    '        .LineWidth = Word.WdLineWidth.wdLineWidth050pt
    '        .Color = Word.WdColor.wdColorAutomatic
    '    End With
    '    With .Borders(Word.WdBorderType.wdBorderVertical)
    '        .LineStyle = Word.WdLineStyle.wdLineStyleSingle
    '        .LineWidth = Word.WdLineWidth.wdLineWidth050pt
    '        .Color = Word.WdColor.wdColorAutomatic
    '    End With
    '    .Borders(Word.WdBorderType.wdBorderDiagonalDown).LineStyle = Word.WdLineStyle.wdLineStyleNone
    '    .Borders(Word.WdBorderType.wdBorderDiagonalUp).LineStyle = Word.WdLineStyle.wdLineStyleNone
    '    .Borders.Shadow = False
    'End With
    ' Save this word document
    oDoc.SaveAs("C:UsersCoDeXeRDesktopWord1.doc", True)
    oDoc.Close()
    oWord.Application.Quit()
    'oWord.Visible = True

End Sub

Public Sub exportToExcel(ByVal dgv As DataGridView)

End Sub

Private Sub ReleaseObject(ByVal obj As Object)
    Try
        System.Runtime.InteropServices.Marshal.ReleaseComObject (obj)
        obj = Nothing
    Catch ex As Exception
        obj = Nothing
    Finally
        GC.Collect()
    End Try
End Sub

 End Class

Понравилась статья? Поделить с друзьями:
  • Excel не прочитывает ячейку в формуле
  • Excel не отображать на диаграмме нулевые значения
  • Excel не протягивает формулу вниз
  • Excel не отображать в графике пустые ячейки
  • Excel не протягивает формулу а копирует