Справочная информация: я пытаюсь использовать доступ для автоматического создания цитаты, но если использовать встроенный для преобразования в PDF. Это не то, что я хочу. Поэтому я пишу некоторые VBA в доступе, чтобы написать в Excel. В моей VBA я открываю шаблон Excel под названием «clean.xlsx» для записи данных из доступа к нему. Снимок экрана представляет собой таблицу как часть шаблона предложения внутри Excel
Q1: Однако иногда мои данные могут быть слишком большими для одной ячейки, и часть их будет скрыта. И я хочу, чтобы go чтобы следующая строка отображалась полностью, а не скрывалась. На скриншоте скрытые данные
Q2: Другое дело, если у меня слишком много предметов. Строки таблицы не расширяются автоматически, хотя я дважды проверил настройку параметров автозамены в Excel. Это просто не работает. Что мне делать?
Вот мой код:
'' '
Option Compare Database
Private Sub Command31_Click()
On Error GoTo SubError
'******************************************************
' Updated Commits
'******************************************************
'1.Quotation no. 10 Error fixed
'2.positions added
'3.Excel is kept open now
'4.Order of items is now same as the natural input order
'5.Weights now have two digits of decimals
'6."kg" is added after weights
'7.Subtotal added
'declare vars
Dim appExcel As Excel.Application
Dim myWorkbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim SQL As String
Dim rsl As DAO.Recordset
Dim i, position As Integer
Dim Message, Title, Default, MyValue
'user input for the quotation no.
Message = "Plz Enter Quotation No.:" ' Set prompt.
Title = "InputBox Demo" ' Set title.
Default = "1" ' Set default.
' Display message, title, and default value.
MyValue = InputBox(Message, Title, Default)
'Show user work is being performed
DoCmd.Hourglass (True)
'******************************************************
' RETRIEVE DATA
'******************************************************
'SQL statement to retrieve Article_No from Quotation_Detail table
'SQL = "SELECT Article_No AS [Article No]" & _
'"FROM Quotation_Detail " & _
'"ORDER BY Article_No "
'SQL statement to retrieve Company(0), Person(1), Telefone(2), Email(3), Address(4), City(5), Postcode(6),
'Province(7), USCI Num(8), Short Name(9) from Customers Table and Buyer(10), Quotation No(11),Quotation
'Date(12), Revision(13), Article_No(14), Quantity(15), Matchcode(16), RMB_price(17),reference(18) from Quotation Query 1,
'Description(19) & Weight(20) from Spare_Parts Table.
SQL = "SELECT Customers.Company, Customers.Person, Customers.Telefone, Customers.[E-Mail], " & _
"Customers.Address, Customers.City, Customers.Postcode, Customers.Province, Customers.[USCI Num], " & _
"Customers.[Short Name], [Quotation Query1].Buyer, [Quotation Query1].[Quotation No], " & _
"[Quotation Query1].[Quotation Date], [Quotation Query1].Revision, " & _
"[Quotation Query1].Article_No, [Quotation Query1].Quantity, [Quotation Query1].Matchcode, " & _
"[Quotation Query1].RMB_price,[Quotation Query1].[Our Reference], Spare_Parts.Description, Spare_Parts.[Weight (kg)] " & _
"FROM Spare_Parts INNER JOIN (Customers INNER JOIN [Quotation Query1] ON Customers.[Short Name] = [Quotation Query1].[Buyer]) ON Spare_Parts.[Article_No] = [Quotation Query1].[Article_No] " & _
"WHERE CStr([Quotation Query1].[Quotation No]) = '" & MyValue & "' "
'To select only one quotation with the quotation no. to make the quotation
'Quotation No. is an auto no.,the index shall be used instead of what seems like
' '"& is fixed format for text
'Execute query and populate recordset
Set rsl = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
'If no data, don't bother opening Excel, just quit
If rsl.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
GoTo SubExit
End If
'Loop each row to print data in rsl(0) to test what's in the rsl
'rsl(0) is the short name
'rsl(1) is the company name
' Contrl G to see what have been printed
' After this, the cursoe will at the end and filuence accessing values of fields in the next step
' Thus, this should be commented out
'Do While Not rsl.EOF
' Debug.Print rsl(5)
' rsl.MoveNext
'Loop
Set appExcel = CreateObject("Excel.Application")
Set myWorkbook = appExcel.Workbooks.Open("C:\Users\Cindy\Desktop\clean.xlsx")
appExcel.Visible = True
Set xlSheet = myWorkbook.Worksheets(1)
With xlSheet
.Name = "Quotation"
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 11
'build quotation info
'Quotation No. in C16
If rsl.Fields(11).Value < 10 Then
.Range("C16").Value = "SHA-002-000" + CStr(rsl.Fields(11).Value)
ElseIf rsl.Fields(11).Value < 100 Then
.Range("C16").Value = "SHA-002-00" + CStr(rsl.Fields(11).Value)
ElseIf rsl.Fields(11).Value < 1000 Then
.Range("C16").Value = "SHA-002-0" + CStr(rsl.Fields(11).Value)
ElseIf rsl.Fields(11).Value < 10000 Then
.Range("C16").Value = "SHA-002-" + CStr(rsl.Fields(11).Value)
Else
GoTo SubExit
End If
'Company name in A6
.Range("A6").Value = Nz(rsl.Fields(0).Value, "")
'Contact Person name in A7
.Range("A7").Value = Nz(rsl.Fields(1).Value, "")
'Fowarding address in A8
.Range("A8").Value = Nz(rsl.Fields(4).Value, "")
'Postcode in A9
.Range("A9").Value = Nz(rsl.Fields(6).Value, "")
' City in C9
.Range("C9").Value = Nz(rsl.Fields(5).Value, "")
' If there's province
If rsl.Fields(5).Value <> rsl.Fields(7).Value Then
' Province in F9
.Range("F9").Value = Nz(rsl.Fields(7).Value, "")
.Range("H9").Value = "Province"
End If
'Telephone in B12
.Range("B12").Value = Nz(rsl.Fields(2).Value, "")
' Email in C13
.Range("C13").Value = Nz(rsl.Fields(3).Value, "")
' USCI in B14
.Range("B14").Value = Nz(rsl.Fields(8).Value, "")
'Revision in F16
.Range("F16").Value = Nz(rsl.Fields(13).Value, "")
' Date in B17
.Range("B17").Value = Nz(rsl.Fields(12).Value, "")
' Reference in C18
If rsl.Fields(18).Value = 1 Then
.Range("C18").Value = "DD"
ElseIf rsl.Fields(18).Value = 2 Then
.Range("C18").Value = "WY"
End If
'Put the name of the feilds in rsl to Cell(1,cols + 1)
'For cols = 0 To rsl.Fields.Count - 1
' .Cells(1, cols + 1).Value = rsl.Fields(cols).Name
'Next
'Copy data from recordset to sheet
'.Range("A2").CopyFromRecordset rsl
'provide initial value to row counter
i = 25
'provide initial value to row posiiton counter
position = 1
'Loop through recordset and copy data from recordset to sheet
Do While Not rsl.EOF
'Item No. are written staring from B25 to the end
.Range("B" & i).Value = Nz(rsl.Fields(14).Value, "")
'Quantitities are written staring from C25 to the end
.Range("C" & i).Value = Nz(rsl.Fields(15).Value, "")
'Unit prices are written starting from I25 to the end
.Range("I" & i).Value = Nz(rsl.Fields(17).Value, "")
'Matcth codes are written starting from D25 to the end
.Range("D" & i).Value = Nz(rsl.Fields(16).Value, "")
'Despcriptions are written starting from E25 to the end
.Range("E" & i).Value = Nz(rsl.Fields(19).Value, "")
'Weights are written starting from H25 to the end
' .Range("H" & i).Value = Format(Nz(rsl.Fields(20).Value, ""), "#,##0.00")
'To add kg after weight
'Have issue: error number:94= invalid use of null even empty checked
If Not IsNull(rsl.Fields(20).Value) Then
.Range("H" & i).Value = CStr(Format(rsl.Fields(20).Value, "#,##0.00")) + "kg"
End If
'Positions are written starting from A25 to the end
.Range("A" & i).Value = Nz(position, "")
'Subtotals are written starting from J25 to the end
.Range("J" & i).Value = rsl.Fields(15).Value * rsl.Fields(17).Value
i = i + 1
position = position + 1
rsl.MoveNext
Loop
End With
'Save as excel file using the input MyValue and clean appExcel
myWorkbook.SaveAs FileName:="C:\Users\Cindy\Desktop\" & MyValue & ".xlsx"
Set appExcel = Nothing
SubExit:
On Error Resume Next
DoCmd.Hourglass False
appExcel.Visible = True
rsl.Close
Set rsl = Nothing
Exit Sub
SubError:
MsgBox "Error Number:" & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, "An Error occured"
GoTo SubExit
End Sub
'''