Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

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

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 09.04.2012, 15:13   #1
Любовь87
Пользователь
 
Регистрация: 27.02.2012
Сообщений: 20
По умолчанию Текстовый формат столбца

Помогите пожалуйста разобраться, не получается задать текстовый формат столбцу "Вид" при записи в файл:
Шапка переданного файла берётся из SUM_ZP
Sub som_RecDisk()
'Îáúÿâëåíèå ïåðåìåííûõ
Dim som_Dbf As Database 'Áàçà äàííûõ
Dim som_Rec As Recordset 'Íàáîð çàïèñåé
Dim som_LRec As Recordset 'Íàáîð çàïèñåé äëÿ ËÑ
Dim som_RDbf As Database 'Áàçà äàííûõ äëÿ çàïèñè
Dim som_RRec As Recordset 'Íàáîð çàïèñåé äëÿ çàïèñè
Dim som_RecF As Recordset 'Îòôèëüòðîâàííûé íàáîð çàïèñåé
Dim som_Namr As String 'Ìàðøðóò áàçû äàííûõ
Dim som_Namf As String 'Ôèëüòð
Dim som_RNamr As String 'Ìàðøðóò áàçû äàííûõ äëÿ çàïèñè
Dim som_RNamf As String 'Èìÿ ôàéëà äàííûõ äëÿ çàïèñè
Dim som_RNamC As String 'Èìÿ ôàéëà äàííûõ äëÿ çàïèñè
Dim som_OGod As Integer 'Îò÷åòíûé ãîä
Dim som_TN As Single '
Dim som_Fio As String
Dim som_Fso
Dim som_Drv
Dim som_Fill
Dim som_DanL As Boolean 'Ïðèçíàê íàëè÷èÿ äàííûõ

''''''''''''''''''''''''
With Workbooks(som_Book).Worksheets("Îò÷ åò")
som_MesO = .Range("J1").Value
som_OGod = .Range("I1").Value
som_dan = .Range("W1").Value
som_arx = .Range("X1").Value
End With
som_Namd = som_dan
som_Namd = InputBox("Ïóòü äëÿ äàííûõ", "", som_Namd)

If som_Namd = "" Then GoTo kon

'Ïðèñâîåíèå íà÷àëüíûõ çíà÷åíèé â ôîðìå
som_Name
som_DanL = False
som_TN = 0
som_Namr = som_Path + "\" + som_RabDB
som_RNamr = som_Path
som_RNamC = "sum" & Mid(Format(som_MesO + 100), 2, 2) _
& Format(som_NomRUPS(som_NPredp)) & ".dbf"
som_RNamf = Dir(som_RNamr & "\sum_zp.dbf", vbNormal)
Set som_Fso = CreateObject("Scripting.FileSystemO bject")
' Set som_Drv = som_Fso.getdrive(som_Fso.getdrivena me("c:\sdzpldisk"))
Set som_Drv = som_Fso.getdrive(som_Fso.getdrivena me(som_dan))
Set som_Fill = som_Fso.getfile(som_Path + "\" + som_RNamf)
If som_Drv.isready Then
'som_Fill.Copy ("c:\sdzpldisk\" & som_RNamC)
som_Fill.Copy (som_Namd & som_RNamC)
Else
MsgBox "Äèñêîâîä íå ãîòîâ!", vbCritical, "Âíèìàíèå"
GoTo kon
End If
'som_RNamf = Dir("c:\sdzpldisk\" & som_RNamC, vbNormal)
som_RNamf = Dir(som_Namd & som_RNamC, vbNormal)
'Îïðåäåëåíèå îò÷åòíîãî ïåðèîäà è îïðåäåëåíèå ñîîòâåòñòâóþùåé êíèãè
With Workbooks(som_Book).Worksheets("Îò÷ åò")
som_MesO = .Range("J1").Value
som_OGod = .Range("I1").Value
End With
'Îòêðûòèå áàçû äàííûõ
Set som_Dbf = OpenDatabase(Name:=som_Namr)
Set som_Rec = som_Dbf.OpenRecordset(Name:=Format( som_OGod), Type:=dbOpenDynaset)
Set som_LRec = som_Dbf.OpenRecordset(Name:="LS", Type:=dbOpenDynaset)
'Set som_RDbf = OpenDatabase(Name:="c:\sdzpldisk", Options:=dbDriverPrompt, ReadOnly:=False, Connect:="dBASE 5.0;")
Set som_RDbf = OpenDatabase(Name:=som_dan, Options:=dbDriverPrompt, ReadOnly:=False, Connect:="dBASE 5.0;")
'Ôèëüòð äàííûõ
som_Namf = "[FORMA]=1 AND [POLE]=2 AND [MES]=" & som_MesO
som_Rec.Filter = som_Namf
Set som_RecF = som_Rec.OpenRecordset()
'Ïðîâåðêà íàéäåí ëè ôàéë
If som_RNamf <> "" Then
'Îòêðûòèå ôàéëà
Set som_RRec = som_RDbf.OpenRecordset(Name:=som_RN amf, Type:=dbOpenDynaset)
'Îáðàáîòêà äàííûõ ôàéëà
Do While som_RecF.EOF = False
If som_TN <> som_RecF.Fields("TN") Then
som_LRec.MoveFirst
som_Fio = ""
Do While som_LRec.EOF = False
If som_LRec.Fields("TN") = som_RecF.Fields("TN") Then
som_Fio = som_LRec.Fields("FIO")
End If
som_LRec.MoveNext
Loop
som_TN = som_RecF.Fields("TN")
End If
Вложения
Тип файла: zip DBF.zip (1.9 Кб, 10 просмотров)
Любовь87 вне форума Ответить с цитированием
Старый 09.04.2012, 15:14   #2
Любовь87
Пользователь
 
Регистрация: 27.02.2012
Сообщений: 20
По умолчанию

Продолжение:
' Çàìåíà êîäîâ ÁÅÈ èþëü 2008
kodvid = som_RecF.Fields("NOM").Value
If kodvid >= "700" Then
kodvid = "236"
End If
If kodvid = "200" Then
kodvid = "276"
End If


som_RRec.AddNew
som_RRec.Fields("Сотрудник").Value = som_TN
som_RRec.Fields("Год").Value = Format(som_OGod)
som_RRec.Fields("Месяц_рег").Value = Format(som_MesO, "0#")
som_RRec.Fields("Месяц_дейс").Value = Format(som_MesO, "0#")
som_RRec.Fields("Вид_расчёт").Value = 236
som_RRec.Fields("SUM").Value = Round(som_RecF.Fields("Sum"), 2)


som_RRec.Fields("Вид").Value = kodvid 'som_RecF.Fields("NOM")
НЕ НРАВИТСЯ Columns("Вид").NumberFormat = "@"
'som_RRec.Fields("Вид").NumberForma t = "@"


som_RRec.Update
som_RecF.MoveNext
som_DanL = True
Loop
End If
som_Dbf.Close
som_RDbf.Close

'Ïðèìåð èç Help ïî VBA:

Dim OldName, NewName
OldName = som_Namd & som_RNamC: NewName = som_Namd & "sum" & Mid(Format(som_MesO + 100), 2, 2) _
& Format(som_NomRUPS(som_NPredp)) & ".xls" ' Îïðåäåëåíèå èì¸í
'MsgBox NewName
Set fs = CreateObject("Scripting.FileSystemO bject")
fs.CopyFile OldName, NewName
Kill OldName
' Name OldName As NewName ' Ïåðåèìåíîâàíèå ôàéëà

'OldName = "som_RNamf = Dir(som_Namd & som_RNamC, vbNormal)": NewName = "som_RNamf = Dir(som_Namd & som_RNamC, vbNormal)"
'Name OldName As NewName ' Ïåðåìåùåíèå è ïåðåèìåíîâàíèå ôàéëà

'Åñëè ïî ÎÑ íåò äàííûõ - ïðåäóïðåæäàþùåå ñîîáåíèå
If som_DanL = False Then
MsgBox "Äàííûå çà " + som_NamMes(som_MesO) & vbNewLine & _
" ìåñÿö íå áûëè ââåäåíû. ", vbCritical, "Âíèìàíèå"
Else
MsgBox "Äàííûå çàïèñàíû." & vbNewLine & som_Namd, vbInformation, "Ê ñâåäåíèþ..."
End If
kon:
End Sub
Любовь87 вне форума Ответить с цитированием
Старый 09.04.2012, 17:47   #3
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Columns("Вид") - нет таких.
Есть
Columns("D")
или
Columns(4)
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 10.04.2012, 06:12   #4
Любовь87
Пользователь
 
Регистрация: 27.02.2012
Сообщений: 20
По умолчанию

Цитата:
Сообщение от Hugo121 Посмотреть сообщение
Columns("Вид") - нет таких.
Есть
Columns("D")
или
Columns(4)
я так тоже пробовала, не получается
Любовь87 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
сконвертировать текстовый файл с программой на языке Паскаль в RTF-формат alldar Паскаль, Turbo Pascal, PascalABC.NET 7 25.08.2011 11:48
Матрица, вставка столбца после столбца с max элементом Phelps Общие вопросы C/C++ 2 24.03.2011 17:15
Сумма из одного столбца с числами в зависимости от интервала дат из другого столбца Severny Microsoft Office Excel 10 14.03.2011 10:13
Формат столбца при выгрузке в Эксель Swatch Microsoft Office Access 3 02.11.2010 19:19
Удаление строк столбца совпадающих со строками другого столбца ShamanGood Microsoft Office Excel 23 18.09.2010 09:26