|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
09.04.2012, 15:13 | #1 |
Пользователь
Регистрация: 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 |
09.04.2012, 15:14 | #2 |
Пользователь
Регистрация: 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 |
09.04.2012, 17:47 | #3 |
Старожил
Регистрация: 11.05.2010
Сообщений: 5,166
|
Columns("Вид") - нет таких.
Есть Columns("D") или Columns(4)
webmoney: E265281470651 Z422237915069 R418926282008
|
10.04.2012, 06:12 | #4 |
Пользователь
Регистрация: 27.02.2012
Сообщений: 20
|
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
сконвертировать текстовый файл с программой на языке Паскаль в 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 |