Текстовый формат поля

Private Sub Form_Current()
    Dim k
    If Me.NewRecord Then
        k = "SELECT top 1 Дозаторы.УД, z.Дата " _
        & "FROM Дозаторы LEFT JOIN " _
        & " (select * from Доз where Дата=" & Format(Me.Дата, "\#mm\/dd\/yyyy\#") & ") as z " _
        & " ON Дозаторы.УД = z.УД " _
        & " where z.УД Is Null and Описание='в работе' " _
        & " order by Дозаторы.код"
    With CurrentDb.OpenRecordset(k)
            If .EOF Then
                Me.AllowAdditions = False
            Else
                Me.УД.DefaultValue = .Fields(0)
            End If
        End With
    End If
End Sub

Me.УД.DefaultValue = "'" & .Fields(0) & "'"

Private Sub Уровень_AfterUpdate()
    
    Me.РеагентФакт = DLookup("[РеагентПлан]", "[Доз]", "[УД]= '" & [УД] & "'" & " AND Дата=" & CLng([Дата] - 1))
 Me.Остаток = Nz(DLookup("[коэф]", "[Дозаторы]", "[УД]= '" & [УД] & "'"), 0) * Nz(Me.Уровень, 0)
 Me.РеагентПлан = DLookup("[РеагентФакт]", "[Доз]", "[УД]= '" & [УД] & "'")
If Me.Уровень < 21 Then
Me.РеагентПлан.Enabled = True
Me.РеагентПлан.SetFocus
Me.РеагентПлан.Dropdown
Me.Долив.Enabled = True
 End If
 If Me.Расход = 0 Then
Me.ПричинаОстан.Enabled = True
 Me.ПричинаОстан.SetFocus
  Me.ПричинаОстан.Dropdown
 End If
End Sub

Option Compare Database
Option Explicit
Private Sub Form_Load()
 
 
 Me.Кнопка55.Enabled = False
 
 
End Sub
 
Private Sub Кнопка55_Click()
Dim RetVal
 
Dim ZipApp$, iFileName$, iArhivName$, adr$, iPath$
 
ZipApp$ = "C:\Program Files\7-Zip\7z.exe a "
' a - заархивировать
' -ep - исключить пути из имён
' -ep1 - исключить базовую папку из пути
' -df - удалить файлы после архивации
iPath = "C:\Documents and Settings\User\Рабочий стол\Новая папка"
iFileName$ = "Дозаторы.xls"
iArhivName$ = "Дозаторы.7z"
adr$ = ZipApp$ & " """ & iPath & iArhivName$ & """ """ & iPath & iFileName$ & """ "
  
 
RetVal = Shell(adr$, vbHide) 'vbNormalFocus)
DoCmd.Close
DoCmd.OpenForm "Рассылка почты", acNormal, "", "", , acWindowNormal
End Sub
 
Private Sub Кнопка5_Click()
 
On Error GoTo Err_Кнопка5_Click
 
 
    DoCmd.Close
 
Exit_Кнопка5_Click:
    Exit Sub
 
Err_Кнопка5_Click:
    MsgBox Err.Description
    Resume Exit_Кнопка5_Click
    
End Sub
 
Private Sub Кнопка53_Click()
Dim db As DAO.Database, rst As DAO.Recordset
    Dim app As Object, wrk As Object, sh As Object
    Dim  k, dt
Dim FileName
 
    Set db = CurrentDb
    
    Set rst = db.OpenRecordset("select * from УДЭ1")
  
If rst.EOF Then
      MsgBox "!!!Без внесения данных УДЭ скв.53 на - " & Date & " не работает !!! "
        
        Exit Sub
        
           End If
FileName = "C:\Documents and Settings\User\Рабочий стол\Новая папка (2)\Дозаторы.xls"
  Set db = CurrentDb
    
    Set rst = db.OpenRecordset("select * from УДЭ")
  
If rst.EOF Then
      MsgBox "!!!Без внесения данных УДЭ Куста 11 на - " & Date & " не работает !!! "
           
        Exit Sub
        
           End If
    
     If app Is Nothing Then Set app = CreateObject("excel.application")
    Set wrk = app.workbooks.Open(FileName)
    dt = app.cells(app.Rows.Count, 2).End(-4162).row
    Set sh = app.worksheets(2)
sh.Name = Format(Date, "d" & "." & "m")
 
 
    
   
    'в файл Давление
  
        Do Until rst.EOF
 
        For k = 1 To dt
            If CStr(app.cells(k, 4)) = CStr(rst!УД) Then
                app.cells(k, 12) = rst!Расход
                app.cells(k, 22) = rst!Остаток
                app.cells(k, 7) = rst!РеагентФакт
                app.cells(k, 9) = rst!РеагентПлан
               
                Exit For
            End If
        Next
        rst.MoveNext
    Loop
 
 app.Visible = True
'Удаление диапазона ячеек после текущей даты
 
'wrk.Save: wrk.Close
 
    Set rst = Nothing
    Set app = Nothing
    Set wrk = Nothing
     Me.Кнопка55.Enabled = True
    Me.Кнопка55.SetFocus
    Me.Кнопка53.Enabled = False
    
    
    
    
 
End Sub