сохранить лист в .dbf в офисе 2010 (без надстроек) - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/сохранить лист в .dbf в офисе 2010 (без надстроек) - Мир MS Excel

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

сохранить лист в .dbf в офисе 2010 (без надстроек) (Макросы/Sub)

сохранить лист в .dbf в офисе 2010 (без надстроек)

Дата: Пятница, 27.02.2015, 14:48 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

Добрый день.
есть макрос который собирает данные на лист "rezultat"
нужно данную информацию сохранить в отдельный .dbf (желательно без надстроек)
P.S. макро подсказал "МатросНаЗебре" и переделан под себя за что ему respect

respect

офис - 2010
знания VBA - нулевые

К сообщению приложен файл: docdim1.xlsm (25.9 Kb) · 4726539.dbf (0.5 Kb)

Ответить

Дата: Пятница, 27.02.2015, 22:17 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 902 ±

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

Excel 2010, 2016

Вот так подойдет?
[vba]

Код

Sub save_dbf()
ThisWorkbook.Sheets("rezultat").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\result.dbf"
End Sub

[/vba]

ЯД: 410013299366744 WM: R193491431804

Ответить

Дата: Суббота, 28.02.2015, 15:47 | Сообщение № 3

Группа: Друзья

Ранг: Старожил

Сообщений: 2348

Репутация: 997 ±

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

Excel 2007,2010,2013

если файлы в одной папке
[vba]

Код

Sub insert_into_dbf()
      Dim objRS: Set objRS = CreateObject("ADODB.Recordset")
      objRS.Open "insert into 4726539 SELECT * from [rezultat$] in '" & ThisWorkbook.FullName & "' 'Excel 8.0;'", _
                 "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & ";Extended Properties=dBASE IV"
      Set objRS = Nothing
End Sub

[/vba]
вместо 4726539 напишите имя вашего dbf файла без расширения

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Суббота, 28.02.2015, 15:48

Ответить

Дата: Понедельник, 02.03.2015, 15:51 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

спасибо. "krosav4ig" 2-пример работает но надо подправить код
на строчку .Cells(iY2, 13).Value = Cells(iY1, 6).Value поставить 2 контроля
1 - ограничить данные до 38 знаков, в "rezultat" забирать только первые 38 знаков (если больше то .dbf не создаётся)
2 - замена "і" кириллица на "і" англий с соблюдением регистра (в .dbf попадает ?????)
ишчо один момент - если поправил данные и запускаю макрос заново то в .dbf новые данные добавлялись к старим - надо чтобы затирало старые или создавало каждый раз новый фаил с новыми данными с новым именем

Сообщение отредактировал docdim - Понедельник, 02.03.2015, 16:44

Ответить

Дата: Понедельник, 02.03.2015, 18:32 | Сообщение № 5

Группа: Друзья

Ранг: Старожил

Сообщений: 2348

Репутация: 997 ±

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

Excel 2007,2010,2013

Цитата docdim, 02.03.2015 в 15:51, в сообщении № 4

тобы затирало старые

docdim, после строки [vba]

Код

Dim objRS: Set objRS = CreateObject("ADODB.Recordset")

[/vba]
добавьте [vba]

Код

objRS.Open "delete * from 4726539", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & ";Extended Properties=dBASE IV"

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 02.03.2015, 18:32

Ответить

Дата: Понедельник, 02.03.2015, 18:40 | Сообщение № 6

Группа: Друзья

Ранг: Старожил

Сообщений: 2348

Репутация: 997 ±

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

Excel 2007,2010,2013

Цитата docdim, 02.03.2015 в 15:51, в сообщении № 4

забирать только первые 38 знаков

docdim, а может в лучше в базе увеличить размеры полей nk_a и nk_b (они e вас в базе ограничены 38 символами)?

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 02.03.2015, 18:41

Ответить

Дата: Понедельник, 02.03.2015, 18:54 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

так ?

[vba]

Код

Sub insert_into_dbf()
      Dim objRS: Set objRS = CreateObject("ADODB.Recordset")
      bjRS.Open "delete * from 4726539", _
                   "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & ";Extended Properties=dBASE IV"
      objRS.Open "insert into 4726539 SELECT * from [rezultat$] in '" & ThisWorkbook.FullName & "' 'Excel 8.0;'", _
                  "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & ";Extended Properties=dBASE IV"
      Set objRS = Nothing
End Sub

[/vba]

Сообщение отредактировал docdim - Понедельник, 02.03.2015, 18:55

Ответить

Дата: Понедельник, 02.03.2015, 19:08 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

Цитата krosav4ig, 02.03.2015 в 18:40, в сообщении № 6

docdim, а может в лучше в базе увеличить размеры полей nk_a и nk_b (они e вас в базе ограничены 38 символами)?

нельзя - строгое ограничение

Ответить

Дата: Вторник, 03.03.2015, 11:01 | Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

- не хватает мне ума собрать код в кучу

Сообщение отредактировал docdim - Вторник, 03.03.2015, 11:52

Ответить

Дата: Вторник, 03.03.2015, 13:50 | Сообщение № 10

Группа: Друзья

Ранг: Старожил

Сообщений: 2348

Репутация: 997 ±

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

Excel 2007,2010,2013

Цитата docdim, 02.03.2015 в 18:54, в сообщении № 7

так ?

вот тут

Цитата docdim, 02.03.2015 в 18:54, в сообщении № 7

[vba]

Код

bjRS.Open "delete * from 4726539", _

[/vba]

ошибочка, должно быть [vba]

Код

objRS.Open "delete * from 4726539", _

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Ответить

Дата: Вторник, 03.03.2015, 13:51 | Сообщение № 11

Группа: Друзья

Ранг: Старожил

Сообщений: 2348

Репутация: 997 ±

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

Excel 2007,2010,2013

Цитата docdim, 02.03.2015 в 15:51, в сообщении № 4

замена "і" кириллица на "і" англий

в исходных данных или в запросе?

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Ответить

Дата: Вторник, 03.03.2015, 14:28 | Сообщение № 12

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

Цитата krosav4ig, 03.03.2015 в 13:51, в сообщении № 11

в исходных данных или в запросе?

без разницы

Ответить

Дата: Вторник, 03.03.2015, 15:00 | Сообщение № 13

Группа: Друзья

Ранг: Старожил

Сообщений: 2348

Репутация: 997 ±

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

Excel 2007,2010,2013

ну тогда держите
[vba]

Код

Sub insert_into_dbf()
     Dim objRS: Set objRS = CreateObject("ADODB.Recordset")
     Dim ConStr$: ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & ";Extended Properties=dBASE IV"
     Dim fields$: fields = "kb_a, kk_a, kb_b, kk_b, d_k, summa, vid, ndoc, i_va, da, da_doc, left(nk_a, 38) as nk_a, Left(nk_b, 38) as nk_b, nazn, kod_a, kod_b"
     With Sheets("rezultat").[L:M]: .Replace "і", "i": .Replace "І", "I": End With
     'создаем пустую таблицу и копируем в нее структуру из 4726539.dbf
     objRS.Open "SELECT * INTO tmp FROM 4726539 WHERE 1>1 ", ConStr
     'записываем значения в созданную таблицу
     objRS.Open "insert into tmp SELECT " & fields & " from [rezultat$] in '" & ThisWorkbook.FullName & "' 'Excel 8.0;'", ConStr
     Set objRS = Nothing
     'переименовываем полученный файл
     Name ThisWorkbook.Path & "\TMP.DBF" As ThisWorkbook.Path & "\resultat " & Format(Now(), "DD_MM_YYYY hh_mm_ss") & ".dbf"
End Sub

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 03.03.2015, 15:00

Ответить

Дата: Вторник, 03.03.2015, 15:38 | Сообщение № 14

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

ошыбка
таблица темп уже существует - [vba]

Код

objRS.Open "SELECT resultat* INTO tmp FROM rezultat WHERE 1>1 ", ConStr

[/vba]

Сообщение отредактировал docdim - Вторник, 03.03.2015, 15:38

Ответить

Дата: Вторник, 03.03.2015, 17:12 | Сообщение № 15

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

resultat 03_03_2015 хх_хх_хх.dbf - создаётся но пустой
данные в nk_a и nk_b вот такие
IIII IIII
IIIIIIIIIIIIIIIIIIIIIII IIIIIIIIIIIII

Ответить

Дата: Вторник, 03.03.2015, 17:22 | Сообщение № 16

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

тут собака зарыта
[vba]

Код

With Sheets("Ëèñò1").[L:M]: .Replace "і", "i": .Replace "І", "I": End With

[/vba]
может замену к "исходнику" применить

Сообщение отредактировал docdim - Вторник, 03.03.2015, 17:50

Ответить

Дата: Вторник, 03.03.2015, 17:34 | Сообщение № 17

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

перекинул на исходник
[vba]

Код

With Sheets("Лист1").[F:F]: .Replace "і", "i": .Replace "І", "I": End With

[/vba]
но почему то работает без соблюдения регистра - все "i"

Ответить

Дата: Среда, 04.03.2015, 10:26 | Сообщение № 18

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

спс. работае pray

pray

Ответить

Дата: Среда, 04.03.2015, 10:59 | Сообщение № 19

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

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

Excel 2010

[vba]

Код

Sub Собрать()
Dim iY1 As Long
Dim iY2 As Long
Dim iX1 As Integer

iY2 = 2
With Sheets("Лист1").[F:F]:
.Replace "і", "i", , , 1:
.Replace "І", "I", , , 1:
.Replace "ААА", "БББ", , , 1:
End With
'On Error Resume Next
Sheets("Лист1").Select

With Sheets("rezultat")
       .Range(.Cells(2, 1), .Cells(Rows.Count, 16)).Clear

       For iY1 = 5 To Cells(Rows.Count, 1).End(xlUp).Row
       For iX1 = 8 To 10
           If Cells(iY1, iX1).Value > 0 Then
               .Cells(iY2, 1).NumberFormat = "@"
               .Cells(iY2, 1).Value = "123456"
               .Cells(iY2, 2).NumberFormat = "@"
               .Cells(iY2, 2).Value = "2526272829"
               .Cells(iY2, 3).NumberFormat = "@"
               .Cells(iY2, 3).Value = Cells(iY1, 25).Value
               .Cells(iY2, 4).NumberFormat = "@"
               .Cells(iY2, 4).Value = Cells(iY1, 24).Value
               .Cells(iY2, 5).Value = 1
               .Cells(iY2, 6).Value = Cells(iY1, iX1).Value * 100
               .Cells(iY2, 7).Value = 1
               .Cells(iY2, 8).Value = Cells(1, 5).Value + iY2 - 2
               .Cells(iY2, 9).Value = 980
               .Cells(iY2, 10).Value = Date
               .Cells(iY2, 11).Value = Date
               .Cells(iY2, 12).Value = "КЕПАКУВ"
               .Cells(iY2, 13).Value = Cells(iY1, 6).Value
               If iX1 = 8 Then .Cells(iY2, 14).Value = "#ФФФФФФФ (ТВП)#,#ффф " & Cells(iY1, 2).Text & " №03-12-" & Cells(iY1, 1).Text
               If iX1 = 9 Then .Cells(iY2, 14).Value = "#ВВВВВВВВВ (ВП)#,#ввв " & Cells(iY1, 2).Text & " №03-12-" & Cells(iY1, 1).Text
               If iX1 = 10 Then .Cells(iY2, 14).Value = "#ПППППППП (НП)#,#пппп " & Cells(iY1, 2).Text & " №03-12-" & Cells(iY1, 1).Text
               .Cells(iY2, 15).Value = "23456789"
               .Cells(iY2, 16).NumberFormat = "@"
               .Cells(iY2, 16).Value = Cells(iY1, 5).Value

               iY2 = iY2 + 1
           End If
       Next
       Next

       .Select
End With
       'Sub insert_into_dbf()
       Dim objRS: Set objRS = CreateObject("ADODB.Recordset")
       Dim ConStr$: ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & ";Extended Properties=dBASE IV"
       Dim fields$: fields = "kb_a, kk_a, kb_b, kk_b, d_k, summa, vid, ndoc, i_va, da, da_doc, left(nk_a, 38) as nk_a, Left(nk_b, 38) as nk_b, nazn, kod_a, kod_b"
       'With Sheets("Лист1").[L:M]: .Replace "?", "i": .Replace "?", "I": End With
       On Error Resume Next
       objRS.Open "drop table tmp", ConStr
       'создаем пустую таблицу и копируем в нее структуру из 4726539.dbf
       objRS.Open "SELECT * INTO tmp FROM rezultat WHERE 1>1 ", ConStr
       'записываем значения в созданную таблицу
       objRS.Open "insert into tmp SELECT " & fields & " from [rezultat$] in '" & ThisWorkbook.FullName & "' 'Excel 8.0;'", ConStr
       Set objRS = Nothing
       'переименовываем полученный файл
       Name ThisWorkbook.Path & "\TMP.DBF" As ThisWorkbook.Path & "\rezultat " & Format(Now(), "DD_MM_YYYY hh_mm_ss") & ".dbf"
End Sub

[/vba]

весь код - может можно почистить ненужные строки
типа 'On Error Resume Next - 2 раза (оставить там где он действительно нужен)

[vba]

Код

Sub Собрать()
Dim iY1 As Long
Dim iY2 As Long
Dim iX1 As Integer

iY2 = 2
With Sheets("Лист1").[F:F]:
.Replace "і", "i", , , 1:
.Replace "І", "I", , , 1:
.Replace "ААА", "БББ", , , 1:
End With
'On Error Resume Next
Sheets("Лист1").Select

With Sheets("rezultat")
       .Range(.Cells(2, 1), .Cells(Rows.Count, 16)).Clear

       For iY1 = 5 To Cells(Rows.Count, 1).End(xlUp).Row
       For iX1 = 8 To 10
           If Cells(iY1, iX1).Value > 0 Then
               .Cells(iY2, 1).NumberFormat = "@"
               .Cells(iY2, 1).Value = "123456"
               .Cells(iY2, 2).NumberFormat = "@"
               .Cells(iY2, 2).Value = "2526272829"
               .Cells(iY2, 3).NumberFormat = "@"
               .Cells(iY2, 3).Value = Cells(iY1, 25).Value
               .Cells(iY2, 4).NumberFormat = "@"
               .Cells(iY2, 4).Value = Cells(iY1, 24).Value
               .Cells(iY2, 5).Value = 1
               .Cells(iY2, 6).Value = Cells(iY1, iX1).Value * 100
               .Cells(iY2, 7).Value = 1
               .Cells(iY2, 8).Value = Cells(1, 5).Value + iY2 - 2
               .Cells(iY2, 9).Value = 980
               .Cells(iY2, 10).Value = Date
               .Cells(iY2, 11).Value = Date
               .Cells(iY2, 12).Value = "КЕПАКУВ"
               .Cells(iY2, 13).Value = Cells(iY1, 6).Value
               If iX1 = 8 Then .Cells(iY2, 14).Value = "#ФФФФФФФ (ТВП)#,#ффф " & Cells(iY1, 2).Text & " №03-12-" & Cells(iY1, 1).Text
               If iX1 = 9 Then .Cells(iY2, 14).Value = "#ВВВВВВВВВ (ВП)#,#ввв " & Cells(iY1, 2).Text & " №03-12-" & Cells(iY1, 1).Text
               If iX1 = 10 Then .Cells(iY2, 14).Value = "#ПППППППП (НП)#,#пппп " & Cells(iY1, 2).Text & " №03-12-" & Cells(iY1, 1).Text
               .Cells(iY2, 15).Value = "23456789"
               .Cells(iY2, 16).NumberFormat = "@"
               .Cells(iY2, 16).Value = Cells(iY1, 5).Value

               iY2 = iY2 + 1
           End If
       Next
       Next

       .Select
End With
       'Sub insert_into_dbf()
       Dim objRS: Set objRS = CreateObject("ADODB.Recordset")
       Dim ConStr$: ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & ";Extended Properties=dBASE IV"
       Dim fields$: fields = "kb_a, kk_a, kb_b, kk_b, d_k, summa, vid, ndoc, i_va, da, da_doc, left(nk_a, 38) as nk_a, Left(nk_b, 38) as nk_b, nazn, kod_a, kod_b"
       'With Sheets("Лист1").[L:M]: .Replace "?", "i": .Replace "?", "I": End With
       On Error Resume Next
       objRS.Open "drop table tmp", ConStr
       'создаем пустую таблицу и копируем в нее структуру из 4726539.dbf
       objRS.Open "SELECT * INTO tmp FROM rezultat WHERE 1>1 ", ConStr
       'записываем значения в созданную таблицу
       objRS.Open "insert into tmp SELECT " & fields & " from [rezultat$] in '" & ThisWorkbook.FullName & "' 'Excel 8.0;'", ConStr
       Set objRS = Nothing
       'переименовываем полученный файл
       Name ThisWorkbook.Path & "\TMP.DBF" As ThisWorkbook.Path & "\rezultat " & Format(Now(), "DD_MM_YYYY hh_mm_ss") & ".dbf"
End Sub

[/vba]

весь код - может можно почистить ненужные строки
типа 'On Error Resume Next - 2 раза (оставить там где он действительно нужен)docdim

Сообщение отредактировал docdim - Среда, 04.03.2015, 11:14

Ответить

Сообщение[vba]

Код

Sub Собрать()
Dim iY1 As Long
Dim iY2 As Long
Dim iX1 As Integer

iY2 = 2
With Sheets("Лист1").[F:F]:
.Replace "і", "i", , , 1:
.Replace "І", "I", , , 1:
.Replace "ААА", "БББ", , , 1:
End With
'On Error Resume Next
Sheets("Лист1").Select

With Sheets("rezultat")
       .Range(.Cells(2, 1), .Cells(Rows.Count, 16)).Clear

       For iY1 = 5 To Cells(Rows.Count, 1).End(xlUp).Row
       For iX1 = 8 To 10
           If Cells(iY1, iX1).Value > 0 Then
               .Cells(iY2, 1).NumberFormat = "@"
               .Cells(iY2, 1).Value = "123456"
               .Cells(iY2, 2).NumberFormat = "@"
               .Cells(iY2, 2).Value = "2526272829"
               .Cells(iY2, 3).NumberFormat = "@"
               .Cells(iY2, 3).Value = Cells(iY1, 25).Value
               .Cells(iY2, 4).NumberFormat = "@"
               .Cells(iY2, 4).Value = Cells(iY1, 24).Value
               .Cells(iY2, 5).Value = 1
               .Cells(iY2, 6).Value = Cells(iY1, iX1).Value * 100
               .Cells(iY2, 7).Value = 1
               .Cells(iY2, 8).Value = Cells(1, 5).Value + iY2 - 2
               .Cells(iY2, 9).Value = 980
               .Cells(iY2, 10).Value = Date
               .Cells(iY2, 11).Value = Date
               .Cells(iY2, 12).Value = "КЕПАКУВ"
               .Cells(iY2, 13).Value = Cells(iY1, 6).Value
               If iX1 = 8 Then .Cells(iY2, 14).Value = "#ФФФФФФФ (ТВП)#,#ффф " & Cells(iY1, 2).Text & " №03-12-" & Cells(iY1, 1).Text
               If iX1 = 9 Then .Cells(iY2, 14).Value = "#ВВВВВВВВВ (ВП)#,#ввв " & Cells(iY1, 2).Text & " №03-12-" & Cells(iY1, 1).Text
               If iX1 = 10 Then .Cells(iY2, 14).Value = "#ПППППППП (НП)#,#пппп " & Cells(iY1, 2).Text & " №03-12-" & Cells(iY1, 1).Text
               .Cells(iY2, 15).Value = "23456789"
               .Cells(iY2, 16).NumberFormat = "@"
               .Cells(iY2, 16).Value = Cells(iY1, 5).Value

               iY2 = iY2 + 1
           End If
       Next
       Next

       .Select
End With
       'Sub insert_into_dbf()
       Dim objRS: Set objRS = CreateObject("ADODB.Recordset")
       Dim ConStr$: ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & ";Extended Properties=dBASE IV"
       Dim fields$: fields = "kb_a, kk_a, kb_b, kk_b, d_k, summa, vid, ndoc, i_va, da, da_doc, left(nk_a, 38) as nk_a, Left(nk_b, 38) as nk_b, nazn, kod_a, kod_b"
       'With Sheets("Лист1").[L:M]: .Replace "?", "i": .Replace "?", "I": End With
       On Error Resume Next
       objRS.Open "drop table tmp", ConStr
       'создаем пустую таблицу и копируем в нее структуру из 4726539.dbf
       objRS.Open "SELECT * INTO tmp FROM rezultat WHERE 1>1 ", ConStr
       'записываем значения в созданную таблицу
       objRS.Open "insert into tmp SELECT " & fields & " from [rezultat$] in '" & ThisWorkbook.FullName & "' 'Excel 8.0;'", ConStr
       Set objRS = Nothing
       'переименовываем полученный файл
       Name ThisWorkbook.Path & "\TMP.DBF" As ThisWorkbook.Path & "\rezultat " & Format(Now(), "DD_MM_YYYY hh_mm_ss") & ".dbf"
End Sub

[/vba]

весь код - может можно почистить ненужные строки
типа 'On Error Resume Next - 2 раза (оставить там где он действительно нужен)

Автор - docdim
Дата добавления - 04.03.2015 в 10:59

сохранить лист в .dbf в офисе 2010 (без надстроек) (Макросы/Sub)

Страница 1 из 1
1

© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!