Конвертировать vba в excel

Функции преобразования типов данных в VBA Excel. Наименования функций, синтаксис, типы возвращаемых данных, диапазоны допустимых значений выражения-аргумента.

Синтаксис функций преобразования

Выражение (аргумент) – это любое строковое или числовое выражение, возвращающее значение, входящее в диапазон допустимых значений для аргумента. Выражение может быть представлено переменной или другой функцией.

Если аргумент, переданный в функцию, не входит в диапазон типа, в который преобразуются данные, происходит ошибка.

Функции преобразования типов

Наименования функций преобразования типов, типы возвращаемых данных, диапазоны допустимых значений для аргумента:

Функция Тип данных Диапазон значений аргумента
CBool Boolean Любое допустимое строковое или числовое выражение.
CByte Byte От 0 до 255.
CCur Currency От -922 337 203 685 477,5808 до 922 337 203 685 477,5807.
CDate Date Любое допустимое выражение даты.
CDbl Double От -1,79769313486231E308 до -4,94065645841247E-324 для отрицательных значений; от 4,94065645841247E-324 до 1,79769313486232E308 для положительных значений.
CDec Decimal 79 228 162 514 264 337 593 543 950 335 для чисел без десятичных знаков. Для чисел с 28 десятичными знаками диапазон составляет 7,9228162514264337593543950335. Наименьшим возможным числом, отличным от нуля, является число 0,0000000000000000000000000001.
CInt Integer От -32 768 до 32 767, дробная часть округляется.
CLng Long От -2 147 483 648 до 2 147 483 647, дробная часть округляется.
CSng Single От -3,402823E38 до -1,401298E-45 для отрицательных значений; от 1,401298E-45 до 3,402823E38 для положительных значений.
CStr String Результат, возвращаемый функцией CStr, зависит от аргумента Выражение.
CVar Variant Диапазон совпадает с типом Double  для числовых значений и с типом  String  для нечисловых значений.

Дополнительно для VBA7:

Функция Тип данных Диапазон значений аргумента
CLngLng LongLong От -9 223 372 036 854 775 808 до 9 223 372 036 854 775 807, дробная часть округляется. Действительно только для 64-разрядных платформ.
CLngPtr LongPtr От -2 147 483 648 до 2 147 483 647 для 32-разрядных платформ, от -9 223 372 036 854 775 808 до 9 223 372 036 854 775 807 для 64-разрядных платформ, дробная часть округляется в обоих типах систем.

Примеры преобразования типов

Функция CBool

Функция CBool используется для преобразования выражений в тип данных Boolean.

Dim a

a = CBool(10) ‘Результат: True

a = CBool(0) ‘Результат: False

a = CBool(«True») ‘Результат: True

a = CBool(«Test») ‘Результат: Error

Dim a, b, c

a = «Test1»

b = «Test2»

c = CBool(a = b) ‘Результат: False

c = CBool(a <> b) ‘Результат: True

Функция CByte

Функция CByte используется для преобразования выражений в тип данных Byte.

Dim a, b, c

a = 654

b = 3.36

c = a / b ‘Результат: 194,642857142857

c = CByte(c) ‘Результат: 195

c = a * b ‘Результат: 2197,44

c = CByte(c) ‘Результат: Error

Функция CCur

Функция CCur используется для преобразования выражений в тип данных Currency.

Dim a, b, c

a = 254.6598254

b = 569.2156843

c = a + b ‘Результат: 823,8755097

c = CCur(a + b) ‘Результат: 823,8755

Функция CDate

Функция CDate используется для преобразования выражений в тип данных Date. Она распознает форматы даты в соответствии с национальной настройкой системы.

Dim a As String, b As Date, c As Double

a = «28.01.2021»

b = CDate(a) ‘Результат: #28.01.2021#

c = CDbl(b) ‘Результат: 44224

Dim a

a = CDate(44298.63895) ‘Результат: #12.04.2021 15:20:05#

a = CDate(44298) ‘Результат: #12.04.2021#

a = CDate(0.63895) ‘Результат: #15:20:05#

Функция CDbl

Функция CDbl используется для преобразования выражений в тип данных Double.

Dim a As String, b As String, c As Double

a = «45,3695423»

b = «548955,756»

c = CDbl(a) + CDbl(b) ‘Результат: 549001,1255423

Примечание
Eсли основной язык системы – русский, при записи в редакторе VBA Excel дробного числа в виде текста, ставим в качестве разделителя десятичных разрядов – запятую. Проверьте разделитель по умолчанию для своей национальной системы:
MsgBox Application.DecimalSeparator

Функция CDec

Функция CDec используется для преобразования выражений в тип данных Decimal.

Dim a As String, b As Double, c

a = «5,9228162514264337593543950335»

b = 5.92281625142643

c = CDec(a) CDec(b) ‘Результат: 0,0000000000000037593543950335

Dim a As Double, b As String, c

a = 4.2643E14

b = CStr(a) ‘Результат: «4,2643E-14»

c = CDec(a) ‘Результат: 0,000000000000042643

Функция CInt

Функция CInt используется для преобразования выражений в тип данных Integer.

Dim a As String, b As Integer

a = «2355,9228»

b = CInt(a) ‘Результат: 2356

Функция CLng

Функция CLng используется для преобразования выражений в тип данных Long.

Dim a As Date, b As Long

a = CDate(44298.63895) ‘Результат: #12.04.2021 15:20:05#

b = CLng(a) ‘Результат: 44299

a = CDate(b) ‘Результат: #13.04.2021#

Функция CSng

Функция CSng используется для преобразования выражений в тип данных Single.

Dim a As String, b As Single

a = «3,2365625106»

b = CSng(a) ‘Результат: 3,236562

Функция CStr

Функция CStr используется для преобразования выражений в тип данных String.

Dim a As Single, b As String

a = 5106.23

b = CStr(a) ‘Результат: «5106,23»

Функция CVar

Функция CVar используется для преобразования выражений в тип данных Variant.

Dim a As Double, b As String, c

a = 549258.232546

b = «Новое сообщение»

c = CVar(a) ‘Результат: 549258,232546 (Variant/Double)

c = CVar(b) ‘Результат: «Новое сообщение» (Variant/String)

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


Numeric values are defined by data types like integer or byte. These data types are used for optimizing the processing and memory allocation in Excel. In this guide, we’re going to show you how to convert string into number in Excel VBA.

Download Workbook

Data types in VBA

Like in some other programming languages, VBA uses data types to identify what variables it can store and how they are stored. Most of the data types in VBA define numeric values. Here is a brief list of numeric data types:

Data type Storage Range
Byte 1 byte 0 to 255
Integer 2 bytes -32,768 to 32,767
Long 4 bytes -2,147,483,648 to 2,147,483,647
Single 4 bytes -3.402823E38 to -1.401298E-45 for negative values; 1.401298E-45 to 3.402823E38 for positive values
Double 8 bytes -1.79769313486231E308 to-4.94065645841247E-324 for negative values; 4.94065645841247E-324 to 1.79769313486232E308 for positive values
LongLong 8 bytes

-9,223,372,036,854,775,808 to 9,223,372,036,854,775,807

Valid on 64-bit platforms only.

Currency 8 bytes -922,337,203,685,477.5808 to 922,337,203,685,477.5807
Decimal 14 bytes +/-79,228,162,514,264,337,593,543,950,335 with no decimal point;
+/-7.9228162514264337593543950335 with 28 places to the right of the decimal

Since there are many numeric data types, there are many functions to convert a string into number in Excel VBA.

Functions to a convert string into number in Excel VBA

All conversion functions use the same syntax: Each requires a single string argument to convert into a number. For example:

Each function returns an error If the string argument either is not a numeric or is outside the range of the data type being converted.

CInt(«A») returns a type mismatch error, because the «A» is not a numeric value.

CByte(«1250») returns an overflow exception.

Function Return type Example
CByte Byte CByte(«65.75») returns 66
CCur Currency CCur(«$256,000.50») returns 256000.5
CDbl Double CDbl(128.239856 * 4.8 * 0.04) returns 24.622052352
CDec Decimal CDec(«15000000.5678») returns 15000000.5678
CInt Integer CInt(«1234.56») returns 1235
CLng Long CLng(«1,500,000.88») returns 15000001
CLngLng LongLong CLngLng(«1,250,500,000.88») returns 1250500001
CSng Single CSng(«5.67854») returns 5.67854

Bonus: Use IsNumeric function to verify value

To avoid type mismatch errors, you can use the IsNumeric function to check if the expression is numeric or not. The function returns Boolean value based on the expression. TRUE if the expression is numeric, FALSE otherwise.

Here is a sample function that can check the data first, and convert the it into an integer if it is numeric. If the argument is not a valid number, the function returns 0.

Function ConvertInt(arg As String) As Integer
 If IsNumeric(arg) Then ConvertInt = CInt(arg)
End Function

Студворк — интернет-сервис помощи студентам

Еще по теме:
1. Тема: Выгрузка с форматированием: задать диапазон выгружаемых данных
2. Тема: Пример записи / чтения с Microsoft Excel в VB

Способы передачи данных с Visual Basic в Excel
Источник: MSDN

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

Дополнительная информация
Чаще всего для передачи данных в книгу Excel используется программирование объектов (автоматизация). Этот способ обладает наибольшим спектром возможностей для указания местоположения данных в книге Excel, а также обеспечивает возможность форматирования книги и настройки различных параметров во время выполнения. Программирование объектов позволяет использовать для передачи данных несколько подходов:

  • Передача данных по одной ячейке
  • Передача массива данных в диапазон ячеек
  • Передача набора записей ADO в диапазон ячеек с помощью способа CopyFromRecordset
  • Создание в листе Excel объекта QueryTable, содержащего результаты запроса по источнику данных ODBC или OLEDB
  • Передача данных в буфер обмена с последующей вставкой содержимого буфера обмена в лист Excel

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

  • Передача данных в текстовый файл, использующий запятые или знаки табуляции в качестве разделителей, который Excel впоследствии может разобрать на ячейки листа
  • Передача данных на лист Excel с помощью ADO
  • Передача данных в Excel с помощью динамического обмена данными (DDE)

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

Примечание. При использовании Microsoft Office Excel 2007 для сохранения книги Excel 2007 можно использовать новый формат файла (XSLX). Для этого найдите следующую строку кода в приведенных ниже примерах:

Visual Basic

oBook.SaveAs "C:Book1.xls"

Замените этот код следующей строкой кода:

Visual Basic

oBook.SaveAs "C:Book1.xlsx"

Кроме того, база данных «Борей» не входит в состав Office 2007 по умолчанию. Тем не менее базу данных «Борей» можно загрузить с веб-узла русской версии Microsoft Office Online.

Перенос данных по одной ячейке с помощью автоматизации

Автоматизация позволяет передавать данные на лист Excel по одной ячейке:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
 
   'Открыть новую книгу Excel
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
 
   'Добавить данные в ячейки первого листа новой книги
   Set oSheet = oBook.Worksheets(1)
   oSheet.Range("A1").Value = "Last Name"
   oSheet.Range("B1").Value = "First Name"
   oSheet.Range("A1:B1").Font.Bold = True
   oSheet.Range("A2").Value = "Doe"
   oSheet.Range("B2").Value = "John"
 
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit

Передача данных по одной ячейке является оптимальным способом передачи небольших объемов данных. Этот способ позволяет помещать данные в любом месте рабочей книги и форматировать ячейки во время выполнения. Однако этот способ не рекомендуется применять при передаче больших объемов данных в книгу Excel. Каждый объект Range, получаемый во время выполнения, вызывает запрос к интерфейсу, поэтому такой способ передачи данных может оказаться очень медленным. Кроме того, в Microsoft Windows 95 и Windows 98 существует ограничение на запросы к интерфейсу, составляющее 64 КБ. При превышении лимита в 64 КБ сервер автоматизации (Excel) может перестать отвечать на запросы или может отображаться сообщение о нехватке памяти. Это ограничение для Windows 95 и Windows 98 рассматривается в следующей статье базы знаний Майкрософт:

216400 Автоматизация COM может привести к зависанию клиентского приложения в Win 95/98 (Эта ссылка может указывать на содержимое полностью или частично на английском языке).

Таким образом, передача данных по одной ячейке допустима только для небольших объемов данных. Для передачи больших объемов данных в Excel следует использовать один из способов, описанных ниже.

Примеры сценариев для автоматизации Excel см. в следующей статье базы знаний Майкрософт:
219151 Использование Visual Basic для автоматизации Microsoft Excel

Передача массива данных в диапазон ячеек листа с помощью программирования объектов

Массив данных можно одновременно передать в диапазон ячеек листа:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
 
   'Открыть новую книгу Excel
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
 
   'Создать массив с 3 столбцами и 100 строками
   Dim DataArray(1 To 100, 1 To 3) As Variant
   Dim r As Integer
   For r = 1 To 100
      DataArray(r, 1) = "ORD" & Format(r, "0000")
      DataArray(r, 2) = Rnd() * 1000
      DataArray(r, 3) = DataArray(r, 2) * 0.7
   Next
 
   'Добавить заголовки в строку 1
   Set oSheet = oBook.Worksheets(1)
   oSheet.Range("A1:C1").Value = Array("Order ID", "Amount", "Tax")
 
   'Передать массив на лист, начиная с ячейки A2
   oSheet.Range("A2").Resize(100, 3).Value = DataArray
   
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit

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

Visual Basic

   oSheet.Range("A2").Resize(100, 3).Value = DataArray

Эта строка представляет всего два запроса к интерфейсу (один для объекта Range, возвращаемого методом Range, и один для объекта Range, возвращаемого методом Resize). При этом при передаче данных по одной ячейке потребовалось бы 300 запросов к интерфейсу для объектов Range. Поэтому по возможности рекомендуется выполнять массовый перенос данных, чтобы сократить число запросов к интерфейсу.

Перенос набора записей ADO в диапазон листа с помощью автоматизации

В Excel 2000 появился метод CopyFromRecordset, позволяющий переносить наборы данных ADO (или DAO) в диапазон ячеек листа. Приведенный ниже сценарий является примером автоматизации Excel 2000, Excel 2002 или Office Excel 2003 для переноса содержимого таблицы Orders образца базы данных «Борей» с помощью метода CopyFromRecordset.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
   'Создать набор записей из всех записей таблицы Orders
   Dim sNWind As String
   Dim conn As New ADODB.Connection
   Dim rs As ADODB.Recordset
   sNWind = _
      "C:Program FilesMicrosoft OfficeOfficeSamplesNorthwind.mdb"
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      sNWind & ";"
   conn.CursorLocation = adUseClient
   Set rs = conn.Execute("Orders", , adCmdTable)
   
   'Создать новую книгу Excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
   Set oSheet = oBook.Worksheets(1)
   
   'Передать данные в Excel
   oSheet.Range("A1").CopyFromRecordset rs
   
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit
   
   'Разорвать соединение
   rs.Close
   conn.Close

Примечание. При использовании версии базы данных «Борей» для Office 2007 необходимо заменить в примере следующую строку кода:

Visual Basic
1
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _ sNWind & ";"

Замените эту строку кода следующей строкой:

Visual Basic
1
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _ sNWind & ";"

В Excel 97 также имеется метод CopyFromRecordset, однако его можно использовать только для набора записей DAO. CopyFromRecordset в Excel 97 не поддерживает ADO.

Дополнительные сведения об использовании ADO и метода CopyFromRecordset см. в следующей статье базы знаний Майкрософт:
246335 Использование программирования объектов для передачи данных из набора записей в Excel
(Эта ссылка может указывать на содержимое полностью или частично на английском языке)

Создание объекта QueryTable с помощью программирования объектов

Объект QueryTable представляет собой таблицу, содержащую данные, возвращенные из внешнего источника. При автоматизации Microsoft Excel для создания объекта QueryTable следует просто указать строку подключения к источнику данных OLEDB или ODBC в строке SQL. Далее Excel генерирует набор записей и вставляет его в указанное местоположение на листе. Использование объекта QueryTables обладает несколькими преимуществами по сравнению с использованием метода CopyFromRecordset:

  • Созданием набора записей и его размещением на листе управляет Excel.
  • Запрос можно сохранить в объекте QueryTable таким образом, чтобы в дальнейшем его можно было обновить и получить обновленный набор записей.
  • При добавлении нового объекта QueryTable к листу можно переместить данные, уже находящиеся в ячейках листа, чтобы свободно разместить новые данные (см. свойство RefreshStyle).

Ниже приводится пример сценария, позволяющего автоматизировать Excel 2000, Excel 2002 или Office Excel 2003 для создания нового объекта QueryTable на листе Excel с данными из базы Northwind:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
   'Создать новую книгу Excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
   Set oSheet = oBook.Worksheets(1)
   
   'Создать объект QueryTable
   Dim sNWind As String
   sNWind = _
      "C:Program FilesMicrosoft OfficeOfficeSamplesNorthwind.mdb"
   Dim oQryTable As Object
   Set oQryTable = oSheet.QueryTables.Add( _
   "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      sNWind & ";", oSheet.Range("A1"), "Select * from Orders")
   oQryTable.RefreshStyle = xlInsertEntireRows
   oQryTable.Refresh False
   
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit

Использование буфера обмена

Буфер обмена Windows также может использоваться как механизм передачи данных на лист Excel. Чтобы вставить данные в несколько ячеек листа, можно скопировать строку, в которой столбцы разделены знаками табуляции, а строки – символами возврата каретки. В приведенном ниже сценарии показано, как Visual Basic может использовать буфер обмена для передачи данных в Excel:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
   'Скопировать строку в буфер обмена
   Dim sData As String
   sData = "FirstName" & vbTab & "LastName" & vbTab & "Birthdate" & vbCr _
           & "Bill" & vbTab & "Brown" & vbTab & "2/5/85" & vbCr _
           & "Joe" & vbTab & "Thomas" & vbTab & "1/1/91"
   Clipboard.Clear
 
   Clipboard.SetText sData
   
   'Создать новую книгу Excel
   Dim oExcel As Object
   Dim oBook As Object
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
   
 
   'Вставить данные
   oBook.Worksheets(1).Range("A1").Select
   oBook.Worksheets(1).Paste
   
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit

Создание текстового файла с разделителями, который Excel может разобрать на строки и столбцы

Excel может открывать файлы с разделителями-запятыми и знаками табуляции и разбирать данные по ячейкам. Этим можно воспользоваться при необходимости передачи большого объема данных в лист Excel с минимальным использованием автоматизации. Этот подход рекомендуется для приложений типа клиент-сервер, поскольку текстовый файл может генерироваться серверным приложением. Затем текстовый файл можно открыть с помощью клиентского приложения, при необходимости используя автоматизацию.

Ниже приведен сценарий, иллюстрирующий создание текстового файла с разделителями-запятыми из набора записей ADO:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
   'Создать набор записей из всех записей таблицы Orders
   Dim sNWind As String
   Dim conn As New ADODB.Connection
   Dim rs As ADODB.Recordset
   Dim sData As String
   sNWind = _
      "C:Program FilesMicrosoft OfficeOfficeSamplesNorthwind.mdb"
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      sNWind & ";"
   conn.CursorLocation = adUseClient
   Set rs = conn.Execute("Orders", , adCmdTable)
   
   'Сохранить набор записей как файл с символами табуляции в качестве разделителей
   sData = rs.GetString(adClipString, , vbTab, vbCr, vbNullString)
   Open "C:Test.txt" For Output As #1
   Print #1, sData
   Close #1
    
   'Разорвать соединение
   rs.Close
   conn.Close
   
   'Открыть новый текстовый файл в Excel
   Shell "C:Program FilesMicrosoft OfficeOfficeExcel.exe " & _
      Chr(34) & "C:Test.txt" & Chr(34), vbMaximizedFocus

Примечание. При использовании версии базы данных «Борей» для Office 2007 необходимо заменить в примере следующую строку кода:

Visual Basic
1
2
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      sNWind & ";"

Замените эту строку кода следующей строкой:

Visual Basic
1
2
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
      sNWind & ";"

Если файл имеет расширение CSV, Excel открывает его без отображения мастера импорта текста и по умолчанию принимает, что в файле используются разделители-запятые. Если же файл имеет расширение TXT, Excel автоматически разбирает его, используя в качестве разделителей знаки табуляции.

В приведенном выше примере запуск Excel осуществлялся с помощью оператора Shell, а имя файла использовалось как аргумент командной строки. А в этом примере автоматизация не использовалась. Однако при желании можно применить минимум автоматизации, чтобы открыть текстовый файл и сохранить его в формате книги Excel:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
   'Создать новый экземпляр Excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
       
   'Открыть текстовый файл
   Set oBook = oExcel.Workbooks.Open("C:Test.txt")
   
   'Сохранить книгу Excel и закрыть Excel
   oBook.SaveAs "C:Book1.xls", xlWorkbookNormal
   oExcel.Quit

Дополнительные сведения об операциях ввода-вывода файлов из приложения Visual Basic см. в следующей статье базы знаний Майкрософт:
172267 RECEDIT.VBP демонстрирует ввод-вывод файлов в Visual Basic recedit.rar
(Эта ссылка может указывать на содержимое полностью или частично на английском языке)

Передача данных на лист Excel с помощью ADO

С помощью Microsoft Jet OLE DB Provider можно добавлять записи в таблицу существующей книги Excel. «Таблицей» в Excel считается диапазон с заданным именем. Первая строка диапазона содержит заголовки (или имена полей), а все последующие строки – записи. Ниже приведен пример создания книги с пустой таблицей MyTable.

Excel 97, Excel 2000 и Excel 2003

1. Откройте новую книгу Excel.
2. Добавьте следующие заголовки в ячейки A1:B1 листа Sheet1:
A1: FirstName B1: LastName
3. Выровняйте ячейку B1 по правому краю.
4. Выделите A1:B1.
5. В меню Вставка выберите Имя, а затем Присвоить. Введите имя MyTable и нажмите кнопку OK.
6. Сохраните новую книгу как C:Book1.xls и закройте Excel.

Чтобы добавить записи в таблицу MyTable с помощью ADO, понадобится сценарий приблизительно следующего вида:

Visual Basic
1
2
3
4
5
6
7
8
9
   'Создать новый объект подключения для Book1.xls
   Dim conn As New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=C:Book1.xls;Extended Properties=Excel 8.0;"
   conn.Execute "Insert into MyTable (FirstName, LastName)" & _
      " values ('Bill', 'Brown')"
   conn.Execute "Insert into MyTable (FirstName, LastName)" & _
      " values ('Joe', 'Thomas')"
   conn.Close

Excel 2007

1. В Excel 2007 создайте книгу.
2. Добавьте следующие заголовки в ячейки A1:B1 листа «Лист1»:
A1: FirstName B1: LastName
3. Выровняйте ячейку B1 по правому краю.
4. Выделите диапазон A1:B1.
5. На ленте откройте вкладку Формулы и выберите пункт Определить имя. Введите имя MyTable и нажмите кнопку ОК.
6. Сохраните новую книгу как C:Book1.xlsx и закройте Excel.

Чтобы добавить записи в таблицу MyTable с помощью ADO, используйте код, подобный приведенному ниже.

Visual Basic
1
2
3
4
5
6
7
8
9
   'Создание объекта соединения для Book1.xls
   Dim conn As New ADODB.Connection
   conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=C:Book1.xlsx;Extended Properties=Excel 12.0;"
   conn.Execute "Insert into MyTable (FirstName, LastName)" & _
      " values ('Scott', 'Brown')"
   conn.Execute "Insert into MyTable (FirstName, LastName)" & _
      " values ('Jane', 'Dow')"
   conn.Close

При подобном добавлении записей в таблицу производится форматирование книги. В приведенном выше примере новые поля, добавляемые в столбец B, выравниваются по правому краю. Каждая запись, добавляемая в строку, форматируется так же, как предыдущая.

Обратите внимание на то, что при добавлении в ячейку или ячейки листа запись заменяет любые данные, находившиеся в этих ячейках ранее; другими словами, строки листа не сдвигаются вниз при добавлении новых записей. Это следует иметь в виду при планировании размещения данных на листе.

Примечание. Обновление данных на листе Excel с помощью ADO или DAO невозможно в среде Visual Basic для приложений в Access после установки пакета обновления 2 (SP2) для Office 2003 или обновления для Access 2002, описанного в статье 904018 базы знаний Майкрософт. Однако этот способ можно использовать в среде Visual Basic для приложений в других приложениях Office, например в Word, Excel и Outlook. Дополнительные сведения см. в следующих статьях базы знаний Майкрософт:
904953 Запрещается вносить изменения, добавлять или удалять данные, источником которых являются книги Excel в Office Access 2003 или в Access 2002
904018 Описание обновления для Access 2002: от 18 октября 2005 г.

Дополнительные сведения об использовании ADO для доступа к книгам Excel см. в следующих статьях базы знаний Майкрософт:
195951 Создание запросов и обновление данных Excel с помощью ADO со страниц ASP
(Эта ссылка может указывать на содержимое полностью или частично на английском языке)

Передача данных в Excel с помощью DDE

Наряду с программированием объектов DDE является способом связи с Excel и передачи данных; однако, в противоположность автоматизации и COM, DDE больше не является часто используемым способом связи с другими приложениями и должен использоваться только при отсутствии других решений.

Для передачи данных в Excel с помощью DDE можно воспользоваться одним из следующих способов:

  • LinkPoke для вставки данных в указанный диапазон ячеек
    .
  • LinkExecute для отправки команд, которые будет выполнять Excel.

В приведенном ниже примере показано, как установить связь DDE с Excel таким образом, чтобы модно было поместить данные в ячейки листа и выполнить команды. В этом примере для успешного установления связи DDE с файлом LinkTopic Excel|MyBook.xls книга с именем MyBook.xls уже должна быть открыта в запущенном экземпляре Excel.

Примечание. При использовании Excel 2007 для сохранения книг можно использовать новый формат файла (XLSX). Обязательно обновите имя файла в приведенном ниже примере кода.

Примечание. В данном примере Text1 представляет элемент управления Text Box формы Visual Basic:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
   'Установить связь DDE с Excel
   Text1.LinkMode = 0
   Text1.LinkTopic = "Excel|MyBook.xls"
   Text1.LinkItem = "R1C1:R2C3"
   Text1.LinkMode = 1
   
   'Вставить текст из Text1 в ячейки R1C1:R2C3 файла MyBook.xls
   Text1.Text = "one" & vbTab & "two" & vbTab & "three" & vbCr & _
                "four" & vbTab & "five" & vbTab & "six"
   Text1.LinkPoke
   
   'Выполнить следующие команды – выбрать ячейку A1 (R1C1) и изменить шрифт
   'format
   Text1.LinkExecute "[SELECT(""R1C1"")]"
   Text1.LinkExecute "[FONT.PROPERTIES(""Times New Roman"",""Bold"",10)]"
   
   'Разорвать связь DDE
   Text1.LinkMode = 0

При использовании метода LinkPoke с Excel необходимо указать диапазон в формате строка-столбец (R1C1) для LinkItem. Если данные вставляются в несколько ячеек, можно использовать строку, в которой столбцы разделены символами табуляции, а строки – символами возврата каретки.

Если метод LinkExecute используется для выполнения команды в Excel, синтаксис команды должен соответствовать языку Excel Macro Language (XLM). Документация по XLM не входит в состав Excel 97 и более поздних версий. Дополнительные сведения о получении документации по XLM см. в следующей статье базы знаний Майкрософт:

143466 Файл Macro97.exe доступен для загрузки. macro97.rar
(Эта ссылка может указывать на содержимое полностью или частично на английском языке)

DDE не является рекомендуемым способом связи с Excel. Программирование объектов предоставляет больше возможностей и обеспечивает лучший доступ к новым функциям Excel.

Все ссылки MSDN по теме:
Автоматизация COM может привести к зависанию клиентского приложения в Win 95/98
Использование Visual Basic для автоматизации Microsoft Excel
Использование программирования объектов для передачи данных из набора записей в Excel
RECEDIT.VBP демонстрирует ввод-вывод файлов в Visual Basic
Запрещается вносить изменения, добавлять или удалять данные, источником которых являются книги Excel в Office Access 2003 или в Access 2002
Описание обновления для Access 2002: от 18 октября 2005 г.
Создание запросов и обновление данных Excel с помощью ADO со страниц ASP (Эта ссылка может указывать на содержимое полностью или частично на английском языке)
Документация по XLM

This is somewhat a continuation on my previous post VBA – Convert XLS to XLSX in which I provided a simple little procedure to upgrade an older xls file to the newer xlsx file format.

I thought to myself, would it be nice to have a more versatile function that could migrate between various other common file formats.

So I set out to take my original function and transform it to enable to user to specify the desired output format and came up with a nice function that enabled anyone to converts Excel compatible files to another Excel compatible format.

Then I said to myself, it must be possible to do something similar for Word and set out to create a function that would enable people to convert file between the various Word compatible formats.

Below are the 2 functions I came up with.

Excel File Format Conversion Function

The following function can be used to convert files between:

  • csv -> xlsx
  • xls -> xlsx
  • xls -> xlsm
  • xls -> txt
  • xlsx -> txt
  • xlsx -> csv
  • and so on…
Enum XlFileFormat
    'Ref: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/xlfileformat-enumeration-excel
    xlAddIn = 18    'Microsoft Excel 97-2003 Add-In *.xla
    xlAddIn8 = 18    'Microsoft Excel 97-2003 Add-In *.xla
    xlCSV = 6    'CSV *.csv
    xlCSVMac = 22    'Macintosh CSV *.csv
    xlCSVMSDOS = 24    'MSDOS CSV *.csv
    xlCSVWindows = 23    'Windows CSV *.csv
    xlCurrentPlatformText = -4158    'Current Platform Text *.txt
    xlDBF2 = 7    'Dbase 2 format *.dbf
    xlDBF3 = 8    'Dbase 3 format *.dbf
    xlDBF4 = 11    'Dbase 4 format *.dbf
    xlDIF = 9    'Data Interchange format *.dif
    xlExcel12 = 50    'Excel Binary Workbook *.xlsb
    xlExcel2 = 16    'Excel version 2.0 (1987) *.xls
    xlExcel2FarEast = 27    'Excel version 2.0 far east (1987) *.xls
    xlExcel3 = 29    'Excel version 3.0 (1990) *.xls
    xlExcel4 = 33    'Excel version 4.0 (1992) *.xls
    xlExcel4Workbook = 35    'Excel version 4.0. Workbook format (1992) *.xlw
    xlExcel5 = 39    'Excel version 5.0 (1994) *.xls
    xlExcel7 = 39    'Excel 95 (version 7.0) *.xls
    xlExcel8 = 56    'Excel 97-2003 Workbook *.xls
    xlExcel9795 = 43    'Excel version 95 and 97 *.xls
    xlHtml = 44    'HTML format *.htm; *.html
    xlIntlAddIn = 26    'International Add-In No file extension
    xlIntlMacro = 25    'International Macro No file extension
    xlOpenDocumentSpreadsheet = 60    'OpenDocument Spreadsheet *.ods
    xlOpenXMLAddIn = 55    'Open XML Add-In *.xlam
    xlOpenXMLStrictWorkbook = 61    '(&;H3D) Strict Open XML file *.xlsx
    xlOpenXMLTemplate = 54    'Open XML Template *.xltx
    xlOpenXMLTemplateMacroEnabled = 53    'Open XML Template Macro Enabled *.xltm
    xlOpenXMLWorkbook = 51    'Open XML Workbook *.xlsx
    xlOpenXMLWorkbookMacroEnabled = 52    'Open XML Workbook Macro Enabled *.xlsm
    xlSYLK = 2    'Symbolic Link format *.slk
    xlTemplate = 17    'Excel Template format *.xlt
    xlTemplate8 = 17    ' Template 8 *.xlt
    xlTextMac = 19    'Macintosh Text *.txt
    xlTextMSDOS = 21    'MSDOS Text *.txt
    xlTextPrinter = 36    'Printer Text *.prn
    xlTextWindows = 20    'Windows Text *.txt
    xlUnicodeText = 42    'Unicode Text No file extension; *.txt
    xlWebArchive = 45    'Web Archive *.mht; *.mhtml
    xlWJ2WD1 = 14    'Japanese 1-2-3 *.wj2
    xlWJ3 = 40    'Japanese 1-2-3 *.wj3
    xlWJ3FJ3 = 41    'Japanese 1-2-3 format *.wj3
    xlWK1 = 5    'Lotus 1-2-3 format *.wk1
    xlWK1ALL = 31    'Lotus 1-2-3 format *.wk1
    xlWK1FMT = 30    'Lotus 1-2-3 format *.wk1
    xlWK3 = 15    'Lotus 1-2-3 format *.wk3
    xlWK3FM3 = 32    'Lotus 1-2-3 format *.wk3
    xlWK4 = 38    'Lotus 1-2-3 format *.wk4
    xlWKS = 4    'Lotus 1-2-3 format *.wks
    xlWorkbookDefault = 51    'Workbook default *.xlsx
    xlWorkbookNormal = -4143    'Workbook normal *.xls
    xlWorks2FarEast = 28    'Microsoft Works 2.0 far east format *.wks
    xlWQ1 = 34    'Quattro Pro format *.wq1
    xlXMLSpreadsheet = 46    'XML Spreadsheet *.xml
End Enum

'---------------------------------------------------------------------------------------
' Procedure : XLS_ConvertFileFormat
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Converts an Excel compatible file format to another format
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sOrigFile     : String - Original file path, name and extension to be converted
' lNewFileFormat: New File format to save the original file as
' bDelOrigFile  : True/False - Should the original file be deleted after the conversion
'
' Usage:
' ~~~~~~
' Convert an xls file into a txt file and delete the xls once completed
'   Call XLS_ConvertFileFormat("C:TempTest.xls", xlTextWindows)
' Convert an xls file into a xlsx file and NOT delete the xls once completed
'   Call XLS_ConvertFileFormat("C:TempTest.xls", False)
' Convert a csv file into a xlsx file and delete the xls once completed
'   Call XLS_ConvertFileFormat("C:TempTest.csv", xlWorkbookDefault, True)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2018-02-27              Initial Release
' 2         2020-12-31              Fixed typo xlDBF24 -> xlDBF4
'---------------------------------------------------------------------------------------
Function XLS_ConvertFileFormat(ByVal sOrigFile As String, _
                               Optional lNewFileFormat As XlFileFormat = xlOpenXMLWorkbook, _
                               Optional bDelOrigFile As Boolean = False) As Boolean
    '#Const EarlyBind = True 'Use Early Binding, Req. Reference Library
    #Const EarlyBind = False    'Use Late Binding
    #If EarlyBind = True Then
        'Early Binding Declarations
        Dim oExcel            As Excel.Application
        Dim oExcelWrkBk       As Excel.Workbook
    #Else
        'Late Binding Declaration/Constants
        Dim oExcel            As Object
        Dim oExcelWrkBk       As Object
    #End If
    Dim bExcelOpened          As Boolean
    Dim sOrigFileExt          As String
    Dim sNewXLSFileExt        As String

    'Determine the file extension associated with the requested file format
    'for properly renaming the output file
    Select Case lNewFileFormat
        Case xlAddIn, xlAddIn8
            sNewFileExt = ".xla"
        Case xlCSV, xlCSVMac, xlCSVMSDOS, xlCSVWindows
            sNewFileExt = ".csv"
        Case xlCurrentPlatformText, xlTextMac, xlTextMSDOS, xlTextWindows, xlUnicodeText
            sNewFileExt = ".txt"
        Case xlDBF2, xlDBF3, xlDBF4
            sNewFileExt = ".dbf"
        Case xlDIF
            sNewFileExt = ".dif"
        Case xlExcel12 = 50    'Excel Binary Workbook *.xlsb
            sNewFileExt = ".xlsb"
        Case xlExcel2, xlExcel2FarEast, xlExcel3, xlExcel4, xlExcel5, xlExcel7, _
             xlExcel8, xlExcel9795, xlWorkbookNormal
            sNewFileExt = ".xls"
        Case xlExcel4Workbook = 35    'Excel version 4.0. Workbook format (1992) *.xlw
            sNewFileExt = ".xlw"
        Case xlHtml = 44    'HTML format *.htm; *.html
            sNewFileExt = ".html"
        Case xlIntlAddIn, xlIntlMacro
            sNewFileExt = ""
        Case xlOpenDocumentSpreadsheet    'OpenDocument Spreadsheet *.ods
            sNewFileExt = ".ods"
        Case xlOpenXMLAddIn    'Open XML Add-In *.xlam
            sNewFileExt = ".xlam"
        Case xlOpenXMLStrictWorkbook, xlOpenXMLWorkbook, xlWorkbookDefault = 51
            sNewFileExt = ".xlsx"
        Case xlOpenXMLTemplate    'Open XML Template *.xltx
            sNewFileExt = ".xltx"
        Case xlOpenXMLTemplateMacroEnabled     'Open XML Template Macro Enabled *.xltm
            sNewFileExt = ".xltm"
        Case xlOpenXMLWorkbookMacroEnabled     'Open XML Workbook Macro Enabled *.xlsm
            sNewFileExt = ".xlsm"
        Case xlSYLK     'Symbolic Link format *.slk
            sNewFileExt = ".slk"
        Case xlTemplate, xlTemplate8    ' Template 8 *.xlt
            sNewFileExt = ".xlt"
        Case xlTextPrinter        'Printer Text *.prn
            sNewFileExt = ".prn"
        Case xlWebArchive         'Web Archive *.mht; *.mhtml
            sNewFileExt = ".mhtml"
        Case xlWJ2WD1        'Japanese 1-2-3 *.wj2
            sNewFileExt = ".wj2"
        Case xlWJ3, xlWJ3FJ3    'Japanese 1-2-3 format *.wj3
            sNewFileExt = ".wj3"
        Case xlWK1, xlWK1ALL, xlWK1FMT   'Lotus 1-2-3 format *.wk1
            sNewFileExt = ".wk1"
        Case xlWK3, xlWK3FM3   'Lotus 1-2-3 format *.wk3
            sNewFileExt = ".wk3"
        Case xlWK4       'Lotus 1-2-3 format *.wk4
            sNewFileExt = ".wk4"
        Case xlWKS, xlWorks2FarEast      'Lotus 1-2-3 format *.wks
            sNewFileExt = ".wks"
        Case xlWQ1       'Quattro Pro format *.wq1
            sNewFileExt = ".wq1"
        Case xlXMLSpreadsheet       'XML Spreadsheet *.xml
            sNewFileExt = ".xml"
    End Select

    'Determine the original file's extension for properly renaming the output file
    sOrigFileExt = "." & Right(sOrigFile, Len(sOrigFile) - InStrRev(sOrigFile, "."))

    'Start Excel
    On Error Resume Next
    Set oExcel = GetObject(, "Excel.Application")          'Bind to existing instance of Excel
    If Err.Number <> 0 Then          'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oExcel = CreateObject("Excel.Application")
    Else          'Excel was already running
        bExcelOpened = True
    End If
    On Error GoTo Error_Handler

    oExcel.ScreenUpdating = False
    oExcel.Visible = False         'Keep Excel hidden until we are done with our manipulation
    Set oExcelWrkBk = oExcel.Workbooks.Open(sOrigFile)    'Open the original file
    'Save it as the requested new file format
    oExcelWrkBk.SaveAS Replace(sOrigFile, sOrigFileExt, sNewFileExt), lNewFileFormat, , , , False
    XLS_ConvertFileFormat = True    'Report back that we managed to save the file in the new format
    oExcelWrkBk.Close False    'Close the workbook
    If bExcelOpened = False Then
        oExcel.Quit    'Quit Excel only if we started it
    Else
        oExcel.ScreenUpdating = True
        oExcel.Visible = True
    End If

    If bDelOrigFile = True Then Kill (sOrigFile)    'Delete the original file if requested

Error_Handler_Exit:
    On Error Resume Next
    Set oExcelWrkBk = Nothing
    Set oExcel = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: XLS_ConvertFileFormat" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    oExcel.ScreenUpdating = True
    oExcel.Visible = True         'Make excel visible to the user
    Resume Error_Handler_Exit
End Function

Word File Format Conversion Function

The following function can be used to convert files between:

  • doc -> docx
  • docx -> dotx
  • docx -> pdf
  • docx -> html
  • and so on…
Enum WdSaveFormat
    'Ref: https://msdn.microsoft.com/en-us/vba/word-vba/articles/wdsaveformat-enumeration-word
    wdFormatDocument = 0    'Microsoft Office Word 97 - 2003 binary file format.
    wdFormatDOSText = 4    'Microsoft DOS text format.  *.txt
    wdFormatDOSTextLineBreaks = 5    'Microsoft DOS text with line breaks preserved.  *.txt
    wdFormatEncodedText = 7    'Encoded text format.  *.txt
    wdFormatFilteredHTML = 10    'Filtered HTML format.
    wdFormatFlatXML = 19    'Open XML file format saved as a single XML file.
'    wdFormatFlatXML = 20    'Open XML file format with macros enabled saved as a single XML file.
    wdFormatFlatXMLTemplate = 21    'Open XML template format saved as a XML single file.
    wdFormatFlatXMLTemplateMacroEnabled = 22    'Open XML template format with macros enabled saved as a single XML file.
    wdFormatOpenDocumentText = 23    'OpenDocument Text format. *.odt
    wdFormatHTML = 8    'Standard HTML format. *.html
    wdFormatRTF = 6    'Rich text format (RTF). *.rtf
    wdFormatStrictOpenXMLDocument = 24    'Strict Open XML document format.
    wdFormatTemplate = 1    'Word template format.
    wdFormatText = 2    'Microsoft Windows text format. *.txt
    wdFormatTextLineBreaks = 3    'Windows text format with line breaks preserved. *.txt
    wdFormatUnicodeText = 7    'Unicode text format. *.txt
    wdFormatWebArchive = 9    'Web archive format.
    wdFormatXML = 11    'Extensible Markup Language (XML) format. *.xml
    wdFormatDocument97 = 0    'Microsoft Word 97 document format. *.doc
    wdFormatDocumentDefault = 16    'Word default document file format. For Word, this is the DOCX format. *.docx
    wdFormatPDF = 17    'PDF format. *.pdf
    wdFormatTemplate97 = 1    'Word 97 template format.
    wdFormatXMLDocument = 12    'XML document format.
    wdFormatXMLDocumentMacroEnabled = 13    'XML document format with macros enabled.
    wdFormatXMLTemplate = 14    'XML template format.
    wdFormatXMLTemplateMacroEnabled = 15    'XML template format with macros enabled.
    wdFormatXPS = 18    'XPS format. *.xps
End Enum

'---------------------------------------------------------------------------------------
' Procedure : Word_ConvertFileFormat
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Converts a Word compatible file format to another format
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sOrigFile     : String - Original file path, name and extension to be converted
' lNewFileFormat: New File format to save the original file as
' bDelOrigFile  : True/False - Should the original file be deleted after the conversion
'
' Usage:
' ~~~~~~
' Convert a doc file into a docx file but retain the original copy
'   Call Word_ConvertFileFormat("C:UsersDanielDocumentsResume.doc", wdFormatPDF)
' Convert a doc file into a docx file and delete the original doc once converted
'   Call Word_ConvertFileFormat("C:UsersDanielDocumentsResume.doc", wdFormatPDF, True)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2018-02-27              Initial Release
'---------------------------------------------------------------------------------------
Function Word_ConvertFileFormat(ByVal sOrigFile As String, _
                                Optional lNewFileFormat As WdSaveFormat = wdFormatDocumentDefault, _
                                Optional bDelOrigFile As Boolean = False) As Boolean
    '#Const EarlyBind = True 'Use Early Binding, Req. Reference Library
    #Const EarlyBind = False    'Use Late Binding
    #If EarlyBind = True Then
        'Early Binding Declarations
        Dim oWord             As Word.Application
        Dim oDoc              As Word.Document
    #Else
        'Late Binding Declaration/Constants
        Dim oWord             As Object
        Dim oDoc              As Object
    #End If
    Dim bWordOpened           As Boolean
    Dim sOrigFileExt          As String
    Dim sNewFileExt           As String

    'Determine the file extension associated with the requested file format
    'for properly renaming the output file
    Select Case lNewFileFormat
        Case wdFormatDocument
            sNewFileExt = "."
        Case wdFormatDOSText, wdFormatDOSTextLineBreaks, wdFormatEncodedText, wdFormatOpenDocumentText, wdFormatText, wdFormatTextLineBreaks, wdFormatUnicodeText
            sNewFileExt = ".txt"
        Case wdFormatFilteredHTML, wdFormatHTML
            sNewFileExt = ".html"
        Case wdFormatFlatXML, wdFormatXML, wdFormatXMLDocument
            sNewFileExt = ".xml"
        Case wdFormatFlatXMLTemplate
            sNewFileExt = "."
        Case wdFormatFlatXMLTemplateMacroEnabled
            sNewFileExt = "."
        Case wdFormatRTF
            sNewFileExt = ".rtf"
        Case wdFormatStrictOpenXMLDocument
            sNewFileExt = "."
        Case wdFormatTemplate
            sNewFileExt = "."
        Case wdFormatWebArchive
            sNewFileExt = "."
        Case wdFormatDocument97
            sNewFileExt = ".doc"
        Case wdFormatDocumentDefault
            sNewFileExt = ".docx"
        Case wdFormatPDF
            sNewFileExt = ".pdf"
        Case wdFormatTemplate97
            sNewFileExt = "."
        Case wdFormatXMLDocumentMacroEnabled
            sNewFileExt = ".docm"
        Case wdFormatXMLTemplate
            sNewFileExt = ".doct"
        Case wdFormatXMLTemplateMacroEnabled
            sNewFileExt = "."
        Case wdFormatXPS
            sNewFileExt = ".xps"
    End Select

    'Determine the original file's extension for properly renaming the output file
    sOrigFileExt = "." & Right(sOrigFile, Len(sOrigFile) - InStrRev(sOrigFile, "."))

    'Start Excel
    On Error Resume Next
    Set oWord = GetObject(, "Word.Application")            'Bind to existing instance of Word
    If Err.Number <> 0 Then            'Could not get instance of Word, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oWord = CreateObject("Word.Application")
    Else            'Word was already running
        bWordOpened = True
    End If
    On Error GoTo Error_Handler

    oWord.Visible = False           'Keep Word hidden until we are done with our manipulation
    Set oDoc = oWord.Documents.Open(sOrigFile)      'Open the original file
    'Save it as the requested new file format
    oDoc.SaveAs2 Replace(sOrigFile, sOrigFileExt, sNewFileExt), lNewFileFormat
    Word_ConvertFileFormat = True      'Report back that we managed to save the file in the new format
    oDoc.Close False      'Close the document
    If bWordOpened = False Then
        oWord.Quit      'Quit Word only if we started it
    Else
        oWord.Visible = True 'Since it was already open, ensure it is visible
    End If

    If bDelOrigFile = True Then Kill (sOrigFile)      'Delete the original file if requested

Error_Handler_Exit:
    On Error Resume Next
    Set oDoc = Nothing
    Set oWord = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: XLS_ConvertFileFormat" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    oWord.Visible = True           'Make excel visible to the user
    Resume Error_Handler_Exit
End Function

Missing File Extensions

Unlike the Excel function, the Word function is currently missing some of the file extensions. I created the general framework, but could not easily find the associated file extensions to some of the file format. You need only complete the missing entry and it will work. So simply update the

sNewFileExt = "."

entries as applicable.

Convert HTML-table to Excel

The code below fetches the HTML-table at https://rasmusrhl.github.io/stuff, and converts it to Excel-format.

The problem is that:

  • Numbers in parentheses are converted to negative numbers
  • Numbers are rounded or truncated

Solution

Thank you all for your great contributions. The varied anwers helped me understand, that for my purposes a workaround was the best
solution: Because I generate the HTML-tables myself, I can control the CSS of each cell. CSS codes exists that instruct Excel how to
interpret cell contents: http://cosicimiento.blogspot.dk/2008/11/styling-excel-cells-with-mso-number.html, also explained in this
question: Format HTML table cell so that Excel formats as text?

In my case the CSS should be text, which is mso-number-format:"\@". It is integrated in R code below:

library(htmlTable)
library(nycflights13)
library(dplyr)

nycflights13::planes %>% 
    slice(1:10) %>% mutate( seats = seats*1.0001,
                            s1    = c("1-5", "5-10", "1/2", "1/10", "2-3", "1", "1.0", "01", "01.00", "asfdkjlæ" ),
                            s2    = c("(10)", "(12)", "(234)", "(00)", "(01)", "(098)", "(01)", "(01.)", "(001.0)", "()" )) -> df 


rle_man <- rle(df$manufacturer)

css_matrix <- matrix( data = "mso-number-format:"\@"", nrow = nrow(df), ncol = ncol(df))
css_matrix[,1] <- "padding-left: 0.4cm;mso-number-format:"\@""
css_matrix[,2:10] <- "padding-left: 1cm;mso-number-format:"\@""
css_matrix[,5] <- "padding-left: 2cm;mso-number-format:"\@""


htmlTable( x = df,  
           rgroup   = rle_man$values, n.rgroup = rle_man$lengths, 
           rnames   = FALSE, align = c("l", "r" ), 
           cgroup   =  rbind(  c("", "Some text goes here. It is long and does not break", "Other text goes here", NA),
                               c( "", "Machine type<br>(make)", "Specification of machine", "Other variables")),
           n.cgroup = rbind(   c(1,8,2, NA),
                               c(1, 3, 5, 2)), 
           css.cell = css_matrix )            -> html_out

temp_file <- tempfile( pattern = "table", fileext = ".html" )
readr::write_file( x = html_out, path = temp_file)
utils::browseURL( temp_file)

That HTML-file can be dragged and dropped into Excel with all cells interpreted as text. Note, only dragging-and-dropping the html-file into excel works, it does not work to open the table in a browser and copy-pasting it into excel.

The only thing missing from this method is the horizontal lines, but I can live with that.

Below is VBA with the same effect as dragging and dropping:

Sub importhtml()
'
' importhtml Macro
'

'
With ActiveSheet.QueryTables.Add(Connection:= _
                                 "URL;file:///C:/Users/INSERTUSERNAME/Desktop/table18b85c0a20f3html.HTML", Destination:=Range("$a$1"))

.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

End Sub

Like this post? Please share to your friends:
  • Конвертировать tmdx в word
  • Конвертировать tiff в word онлайн с возможностью редактирования текста
  • Конвертировать tiff в word онлайн бесплатно
  • Конвертировать sunrav в word
  • Конвертировать spss в excel