| |
|
|
| | Здравствуйте, коллеги! :)
Тут уже поднималчся этот вопрос, но я не могу найти топик...
При экспорте в Excel форматирование готового файла работает только со второго раза.
Как єто побороть? | |
| |
| |
| |
|
|
| | не запускать 'первый' раз | |
| |
| |
| |
|
|
| | Ценю юмор.
Юмор, вообще, лучшее что придумал челдовеческий тональ.
Однако и Excel он придумал, за каким-то чертом.
Так что делать то? :) | |
| |
| |
| |
|
|
| | а как экспортируете ?
в шаблон или создаете новый документ ?
покажите код, где открываете эксель | |
| |
| |
| |
|
|
| | Экспортирую с помощью DoCmd.OutputTo
Ну а потом редактирование (раскраска там всякая, шрифты, заголовки и прочая чепуха для красоты). | |
| |
| |
| |
|
|
| | to shaucha
у меня юмор, а у Вас ребус. нам в мурзилку писать можно :)
>>При экспорте в Excel форматирование готового файла работает только со второго раза
это вообще как? | |
| |
| |
|
|
| |
|
|
| | типа: а не скажу?  | |
| |
| |
| |
|
|
| | Ну почему же.
Получается такая история:
запуская экспорт в Эксель получаю неотформатированный файл.
Запускаю вотрой раз туже процедуру - получаю отформатированный файл.
Все срабатывает только со сторого раза.
Ну, если запустить процедуру еще раз - все уже работает нормально.
Никаких закономерностей выявить не удалось.
Ну и я тут видел уже топик про это.
Тогда внимания особого не обратил на это. А тут сам столкнулся.
Понимаю, что проблема решаема. | |
| |
| |
| |
|
|
| | Ну так процедурку то покажите.
 | |
| |
| |
| |
|
|
| | Ну тут не все так просто...
Ну, как пример (потому что и тут тоже не работает), вот:
DoCmd.OutputTo acTable, "tblRep_SKUCat", acFormatXLS, "КаталогSKU_Выборка.xls", True, "", 0
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlGeneral
.Font.Name = "Verdana"
.Font.Size = 8
.Font.ColorIndex = 1
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.ColorIndex = 56
End With
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Font
.Name = "Verdana"
.Size = 7
End With
Selection.Font.Bold = True
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Range("A1:B1").Select
Selection.Interior.ColorIndex = 56
Selection.Font.ColorIndex = 2
Range("E1").Select
Selection.Interior.ColorIndex = 11
Selection.Font.ColorIndex = 2
Range("F1").Select
Selection.Interior.ColorIndex = 10
Selection.Font.ColorIndex = 2
Range("G1").Select
Selection.Interior.ColorIndex = 46
Selection.Font.ColorIndex = 2
Range("J1").Select
Selection.Interior.ColorIndex = 56
Selection.Font.ColorIndex = 2
Range("C2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter
ActiveWindow.DisplayGridlines = False
Sheets("tblRep_SKUCat").Select
Sheets("tblRep_SKUCat").Name = "Каталог SKU"
Range("A1").Select
ActiveWorkbook.Save
|
| |
| |
| |
| |
|
|
| | классическая ошибка:
вот например это Range какому объекту принадлежит?
Нужно создать объект excel и потом с ним работать, а у вас выходит какое-то безадресное общение с excel | |
| |
| |
| |
|
|
| | Слава Аллаху!
Расскажите что и как, пожалуйста, а то я... ну вы сами поняли ))
Файл эксель создается через OutputTo и открывается сразу.
Т.е. он уже есть.
И мне нужно в нему обратиться, правильно?
Вот я и не знаю как. | |
| |
| |
| |
 25 Кб. |
|
| | вот Вам небольшой пример по теме (когда-то делал)
но, правда сам таким методом уже не пользуюсь. предпочитаю в excel данные через ado.recordset передавать | |
| |
| |
| |
|
|
| | Спасибо.
Но весь ужас моего положения в том, что я не могу ничего скачивать из интернета, благодаря бдительным работиников отдела IT обеспечения. | |
| |
| |
| |
|
|
| | тогда так:
Sub StartRpt_Schet(ByVal qryName As String, ByVal QryCriteria As String, ByVal strHeader As String)
On Error GoTo Err_StartRpt_Schet
Dim xlSheet As Excel.Worksheet
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim MyRange As Excel.Range
Dim ExportFile As String
Dim NumRow As Long
ExportFile = CurrentProject.Path & "\Отчет от " & Format(Date, "dd mm yy") 'Имя сохраняемого файла
If ExportFile = "" Then Exit Sub
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add 'Создание файла Excel
'Сохранение файла под именем = ExportFile
xlBook.SaveAs FileName:=ExportFile, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'Закрыть файл
xlBook.Close False
'Экспорт данных в предварительно созданный файл
DoCmd.SetWarnings 0 'Подавление сообщений Access (на добавление записей)
DoCmd.RunSQL "SELECT " & qryName & ".* INTO " & qryName & " IN '" & ExportFile & "'[Excel 8.0;HDR=YES;IMEX=2] FROM " & qryName & QryCriteria & ";"
DoCmd.SetWarnings -1 'Включаем вывод сообщений
Set xlBook = xlApp.Workbooks.Open(ExportFile) 'Открыть файл
Set xlSheet = xlBook.Worksheets(qryName)
'xlApp.Visible = True 'Показать объект Excel
'xlApp.ScreenUpdating = False 'Выключить обновление экрана Excel
xlBook.Sheets(qryName).Move Before:=xlBook.Sheets(1) 'Переместить лист
With xlSheet
.Cells(1, 1).Select
.Cells.Font.Name = "Times New Roman"
.Application.Selection.CurrentRegion.Select
.Application.Selection.Borders.Weight = xlThin
.Application.Selection.SpecialCells(xlCellTypeLastCell).Select
NumRow = .Application.Selection.Row 'Номер последней строки
.Cells(1, 1).Select
'Подпись таблицы
.Cells(1, 1).EntireRow.Insert
Set MyRange = .Range(.Cells(1, 1), .Cells(1, 6))
MyRange.Merge
MyRange = UCase(strHeader) & Chr(10) & "по состоянию на " & Format(Date, "dd mmmm yyyy") & " г."
MyRange.Font.Size = 10
'Подпись колонок таблицы и указание ширины столбцов
.Cells(2, 1) = "№" & Chr(10) & "п/п"
.Cells(2, 2) = "Дата счета"
.Cells(2, 3) = "Организация"
.Cells(2, 4) = "Наименование работ/услуг"
.Cells(2, 5) = "Сумма счета"
.Cells(2, 6) = "Дата оплаты"
.Columns(1).ColumnWidth = 5.57
.Columns(2).ColumnWidth = 10
.Columns(3).ColumnWidth = 25
.Columns(4).ColumnWidth = 25
.Columns(5).ColumnWidth = 10
.Columns(6).ColumnWidth = 10
'Выравнивание по горизонтальному центру
.Rows("1:2").VerticalAlignment = xlCenter
.Rows("1:2").HorizontalAlignment = xlCenter
'Высота строки для шапки
.Rows("1:2").RowHeight = 35
'Жирним подпись таблицы и ее шапку
.Rows("1:2").Font.Bold = True
'Включаем нумерацию строк
.Range(.Cells(3, 1), .Cells(NumRow + 1, 1)).FormulaR1C1 = "=ROW()-2"
.Range(.Cells(3, 1), .Cells(NumRow + 1, 1)).HorizontalAlignment = xlCenter
'Формат отображения сумм
.Range(.Cells(3, 5), .Cells(NumRow + 2, 5)).NumberFormat = "#,##0"
'Разрешить перенос слов в ячейках
.Range(.Cells(1, 1), .Cells(NumRow + 1, 6)).Cells.WrapText = True
'Выравнивание по вертикальному центру
.Range(.Cells(3, 1), .Cells(NumRow + 1, 6)).VerticalAlignment = xlTop
'Итоговая запись с суммированием по столбцу
.Cells(NumRow + 2, 4) = "Всего"
.Rows(NumRow + 2).Font.Bold = True
.Cells(NumRow + 2, 5).FormulaR1C1 = "=SUM(R[-" & NumRow - 1 & "]C:R[-1]C)"
.Cells(2, 2).Select
'Поиск vbNewLine и замена на Chr(10). Excel не понимает Chr(13),
'но ставит, почему-то квадратик (как неопознаный символ) + Chr(10)
xlApp.DisplayAlerts = False 'Подавление сообщений Excel, на тот случай если не окажется искомых к замене записей
xlApp.Cells.Replace What:=vbNewLine, Replacement:=Chr(10), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
xlApp.DisplayAlerts = True 'Включение сообщений
End With
'xlApp.ScreenUpdating = True 'Включить обновление экрана Excel
xlApp.Visible = True 'Показать объект Excel
xlBook.Save 'Сохранить все изменения
Set xlApp = Nothing
Set xlBook = Nothing
Exit Sub
Err_StartRpt_Schet:
Call ErrorBases(err)
End Sub
|
что не понятно, спрашивайте | |
| |
| |
|
|
