Excel VBA Создание/переписывание новой книги и использование кнопки отмены. Создать новую книгу excel vba

Excel VBA - UsingVBA для создания новой форматированной книги

Поскольку мой предыдущий ответ был удален (считается «неудобным»), я должен предоставить лучший вариант.

Если вы хотите выводить данные из Access в Excel, вы должны следовать этим шагам:

Создать (или открыть) новую книгу
Читать ваши данные
запись данных в Учебное пособие
Формат данных в рабочей книге

я остановлюсь на выходных данных, и оставить форматирование из (паритет данных t является сложным ... форматирование легко)

Прежде всего, вам нужно включить объекты Excel в вашем файле доступа: меню «Сервис»> «Ссылки». Найдите библиотеку объектов Microsoft Excel 12.0 и установите флажок. Теперь у вас есть полная библиотека Excel к вашим услугам :-)

Настало время для хруста данных. Я предполагаю, что вам нужно, чтобы создать новую книгу:

public sub createExcelFile() dim XL as Excel.Application, WB as Excel.Workbook, WKS as Excel.Worksheet dim db as DAO.database, rec as DAO.recordset, f as DAO.field dim i as integer, j as integer ' Prepare your Excel stuff Set XL = new Excel.Application XL.Visible = True Set WB = XL.Workbooks.Add WB.Activate Set WKS = WB.ActiveSheet ' Default: The first sheet in the newly created book ' Read your data here set db = currentdb() set rec = db.openrecordset("tblSampleData") ' A simple table that will show the data from rec ' i and j will be the coordiantes of the active cell in your worksheet with rec .movefirst ' The table headers i = 1 j = 1 for each f in .fields WKS.cells(i,j).value = f.name j = j + 1 next f ' The table data do i = i+1 j = 1 for each f in .Fields WKS.cells(i,j).value = f.value j = j+1 next f .moveNext loop until .EOF end with end sub

Если вы хотите отформатировать ячейки, вы можете использовать WKS.cells(i,j) (или WKS.range(...)) свойств.

Взгляните на ссылку, которую я раньше оставил (что Siddarth Rout было добрым, чтобы перейти к комментариям).

Я надеюсь, что это поможет вам

stackoverrun.com

Excel VBA Создание/переписывание новой книги и использование кнопки отмены

У меня есть макрос, написанный с диапазоном от одной книги и копией в новую книгу, которая затем сохраняет недавно созданную книгу (и дает ей имя) в тот же путь к папке. Когда эта рабочая книга уже существует (переписывая книгу), появляется диалоговое окно по умолчанию Windows, спрашивающее, хотите ли вы перезаписать, с отменой выбора кнопок «да». Когда кнопка отмены нажата, создается новая книга. Как отредактировать этот код, чтобы при нажатии на отмену не было создано новой рабочей книги? Я вставил макрос ниже:

Sub ExportNewBook() Application.ScreenUpdating = False Dim ThisWB As Workbook Set ThisWB = ActiveWorkbook Set NewBook = Workbooks.Add On Error Resume Next ThisWorkbook.Worksheets("Summary").Range("A1:I100").Copy NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues) NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteFormats) NewBook.Worksheets("Sheet1").Range("A:J").Columns.AutoFit NewBook.SaveAs Filename:=ThisWB.Path & "\" & NewBook.Worksheets("Sheet1").Range("A4").Value & "_Summary" NewBook.ActiveSheet.Range("A1").Select Application.ScreenUpdating = True End Sub

EDIT: РАБОЧАЯ приведенный ниже код

Sub ExportNewBook() Application.ScreenUpdating = False Dim ThisWB As Workbook Dim fname As String Set ThisWB = ActiveWorkbook Set Newbook = Workbooks.Add ThisWorkbook.Worksheets("Summary").Range("A1:I100").Copy Newbook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues) Newbook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteFormats) Newbook.Worksheets("Sheet1").Range("A:J").Columns.AutoFit fname = ThisWB.Path & "\" & ThisWB.Worksheets("Summary").Range("A4").Value & "_Summary.xls" If Dir(fname) <> "" Then If MsgBox("Summary output already exists, are you sure you want to overwrite?", vbOKCancel) = vbCancel Then Newbook.Close False: Application.CutCopyMode = False: Exit Sub End If Application.DisplayAlerts = False Newbook.SaveAs Filename:=fname Application.DisplayAlerts = True ThisWB.Activate ActiveWorkbook.Worksheets("Summary").Range("A1").Select Newbook.Activate ActiveWorkbook.ActiveSheet.Range("A1").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Спасибо!

stackoverrun.com

[excel-vba] Создание книги с пользовательским именем без сохранения на диске

Просто создайте книгу и не сохраняйте ее, поэтому, когда пользователь попытается ее сохранить, пользователь получит подсказку «Сохранить как». И если пользователь попытается закрыть его, пользователь получит подсказку, хотите ли пользователи сохранить ( снова диалог «Сохранить как» ) файл перед закрытием. Теперь появление этого запроса будет зависеть от того, что вы внесли некоторые изменения во вновь созданную книгу.

Например

Sub Sample() Dim wb As Workbook Set wb = Workbooks.Add End Sub

По умолчанию книга будет называться «Книга», но это действительно не имеет значения, так как пользователь получит возможность сделать «Сохранить как»,

СЛЕДОВАТЬ ЗА

Нажимая Ctrl + S. Появится диалоговое окно «Сохранить как ...», как если бы книга не была сохранена.

Хотя я упомянул, что есть только один способ, о котором я могу думать, но, работая над кодом, я придумал 2 варианта:

ПУТЬ 1

a) Создать новую книгу

б) Сохраните его, скажем, JAN 2012.XLSM, в каталог пользователя Temp

c) Измените свойства файла на Readonly

d) Теперь, когда пользователь нажимает CTRL + S, Excel предложит Save As

Option Explicit Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Const MAX_PATH As Long = 260 Sub Sample() Dim wb As Workbook Set wb = Workbooks.Add With wb .SaveAs Filename:=TempPath & "JAN 2012.xlsm" _ , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False '.SaveAs Filename:=TempPath & "JAN 2012.xlsx" _ , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False .ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin" End With End Sub Function TempPath() As String TempPath = String$(MAX_PATH, Chr$(0)) GetTempPath MAX_PATH, TempPath TempPath = Replace(TempPath, Chr$(0), "") End Function

ПУТЬ 2 (Сложный способ сделать это)

a) Создать новую книгу

б) Сохраните его, скажем, JAN 2012.XLSM, в каталог пользователя Temp

c) Внесите код, чтобы отключить Ctrl + S и разрешить только Сохранить как

code-examples.net

Excel VBA – Использование VBA для создания новой форматированной книги MS Excel онлайн

Я пытаюсь написать последнюю часть своей программы, и мне нужно извлечь данные из документа Access и распечатать его в новой книге.

Для начала я буду использовать имена поставщиков продуктов и создать Рабочую таблицу с каждым именем поставщиков, затем я хочу, чтобы они проходили через каждый лист и печатали продукты от каждого заказанного поставщика.

Я действительно борется с тем, чтобы обернуть голову, как открыть новую книгу и напечатать в моей информации.

Поскольку мой предыдущий ответ был удален (считается «неудобным»), я должен обеспечить лучший.

Если вы хотите выводить данные из Access в Excel, вам необходимо выполнить следующие действия:

Создать (или открыть) новую книгу
Прочтите данные
Напишите свои данные в книгу
Отформатируйте данные в книге

Я сосредоточусь на выводах данных и оставляю форматирование (часть данных сложна … форматирование прост)

Во-первых, вам нужно включить объекты Excel в вашем файле Access: меню «Сервис»> «Ссылки». Найдите библиотеку объектов Microsoft Excel 12.0 и установите флажок. Теперь у вас есть полная библиотека Excel на вашем сервисе 🙂

Сейчас настало время для хруста. Я буду считать, что вам нужно создать новую книгу:

Если вы хотите отформатировать ячейки, вы можете использовать WKS.cells(i,j) (или WKS.range(...) ).

Взгляните на ссылку, которую я раньше оставил (что Siddarth Rout было добрым, чтобы перейти к комментариям).

Я надеюсь, это поможет вам

Option Compare Database Public Function format(filepath, sheetname) Set xls = CreateObject("EXCEL.APPLICATION") xls.screenupdating = False xls.displayalerts = False xls.Visible = True xls.workbooks.Open filepath Set xlsdd = xls.ActiveWorkbook

'удаление заголовков

xls.Range("1:1").Select xls.Selection.Delete Shift:=xlUp

'добавление одной колонки

xls.Columns("A:A").Select xls.Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'adding 5 rows

«ActiveWorkbook.Sheets ( "Лист1"). Выберите

xls.Rows("1:5").Insert Shift:=xlDown

'выборка строк из доступа и включение их в excel

strsql = "select top 5 " & sheetname & ".* into top5_records from " & sheetname DoCmd.RunSQL strsql outputFileName = "C:\Users\hp\Desktop\top5_records.xls" DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "top5_records", outputFileName, True

'затем откройте это excel и скопируйте строки

Set xls2 = CreateObject("EXCEL.APPLICATION") xls2.screenupdating = False xls2.displayalerts = False xls2.Visible = True xls2.workbooks.Open outputFileName Set xlsdd2 = xls.ActiveWorkbook xls2.Rows("1:5").Select xls2.Selection.Copy xls.Cells(1, 1).Select xls.activesheet.Paste ' Dim currdb As DAO.Database ' Dim rst As DAO.Recordset ' ' Set currdb = CurrentDb ' Set rst = currdb.OpenRecordset(strsql) '<<<Opens query recordset via DAO ' rst.MoveLast ' rowsToReturn = rst.RecordCount ' Set rng = xls.Cells(1, 1) ' 'copy specified number of records to worksheet ' 'rng.CopyFromRecordset rst, rowsToReturn '<<<Gets all records in recordset

'сделать первую 6-ю строку смелой

xls.Rows("6:6").Select With xls.Selection.Font .Bold = True .Name = "Arial" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False End With

'автоподтвердить данные

xls.Sheets(sheetname).Cells.Columns.autofit xls.CutCopyMode = False With xlsdd .Save .Close End With xls.Visible = False Set xlsdd = Nothing Set xls = Nothing End Function

Вы можете определить ширину столбца / строки до значения статического пикселя или автоматической подгонки, такие вещи, как полужирный, являются предварительно определенными

пример

Selection.Font.Bold = True

Вы также можете создать таблицу шаблонов, скопировать содержимое в шаблон и сохранить как. Ваше сообщение не указывает, сколько форматирования необходимо выполнить.

Вы не даете много деталей, поэтому я не могу дать вам много деталей взамен. Но вот как я это сделаю:

Создайте новую книгу вручную с двумя листами
На одном листе добавьте таблицу внешних данных, которая возвращает список имени поставщика, например SELECT SupplierName FROM tblSuppliers WHERE Active = True; или что-то типа того.
Создайте диапазон имен на рабочей книге, который динамически расширяется с помощью этой таблицы запросов
На втором листе добавьте таблицу внешних данных, например SELECT * FROM Orders WHERE SupplierName =? (Это будет запрос параметра). Запустите эту таблицу внешних данных в строке 3
Я сверлю, поставьте поле со списком, которое указывает на список поставщиков.

Теперь VBA прост

ThisWorkbook.RefreshAll

Вместо одного листа для каждого поставщика у вас будет один лист, на котором вы можете изменить поставщика. Вот навыки, которые вам понадобятся

Создание таблицы внешних данных
Создайте запрос параметра (старая ссылка http://www.dicks-clicks.com/excel/ExternalData6.htm )
Создание динамически расширяющегося имени диапазона

Добавьте сопоставление или проверку данных, указывающую на диапазон на другом листе
Очевидно, что SQL выше не прав, но я предполагаю, что вы можете написать правильный оператор SQL

Вы должны быть в состоянии найти детали обо всем этом, но если нет, задайте другой вопрос.

excel.bilee.com

Excel VBA Создание / перезапись новой книги и использование кнопки отмены MS Excel онлайн

Вот возможный подход:

Sub ExportNewBook() Application.ScreenUpdating = False Dim ThisWB As Workbook, Newbook As Workbook Dim fname As String Set ThisWB = ActiveWorkbook fname = ThisWB.Path & "\" & ThisWB.Sheets("Sheet1").Range("A4").Value & "_Summary" If Dir(fname) <> "" Then If MsgBox("Are you sure you want to overwrite?", vbOKCancel) = vbCancel Then Exit Sub End If Set Newbook = Workbooks.Add ThisWB.Worksheets("Summary").Range("A1:I100").Copy Newbook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues) Newbook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteFormats) Newbook.Worksheets("Sheet1").Range("A:J").Columns.AutoFit 'This code should be faster since it bypasses the copy-paste buffer 'With Newbook.Sheets(1) ' ThisWB.Sheets("Summary").Range("A1:I100").Copy .Range("A1") ' .Range("A1:I100").Value = .Range("A1:I100").Value ' .Columns.AutoFit 'End With Application.DisplayAlerts = False Newbook.SaveAs Filename:=fname Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

При ошибке резюме следующий редко бывает хорошей идеей. Если пользователь не выбирает или отменяет, запускается ошибка. Лучше справиться с этой ошибкой, чтобы удалить нежелательную книгу (хотя еще одна идея – проверить, существует ли рабочая книга с целевым именем до ее создания, и если это так, используйте msgbox, чтобы спросить у пользователя, хотите ли они перезаписать файл и, если поэтому, только тогда создайте книгу, отключите оповещения и только затем выполните saveas).

Кажется, что проблема заключается в том, что вам нужно иметь имя файла, чтобы убить книгу. В вашей ситуации книга еще не имеет имени файла. Одним из решений является создание безопасного имени файла, единственной целью которого является убить нежелательную книгу, снова сохранить это имя, а затем убить. Что-то вроде этого:

Sub Test() On Error GoTo err_handler Dim wb As Workbook Dim fname As String Dim tempname As String fname = "C:\Programs\testbook.xlsx" Set wb = Workbooks.Add wb.Sheets(1).Range("A1").Value = Now 'for testing purposes wb.SaveAs fname Exit Sub err_handler: tempname = "C:\Programs\name_i_will_never_use.xlsx" wb.SaveAs tempname wb.Close Kill tempname End Sub

это полный код с

проверить, существует ли файл
если есть, закройте новую книгу и спросите, будет ли существующий файл открыт
закрыть новую книгу
в случае ошибки сохраните новую книгу с суффиксом (ошибка) перед файлом расширения

Sub ExportNewBook() Application.ScreenUpdating = False Dim ThisWB As Workbook Dim NewName As String Set ThisWB = ActiveWorkbook Set NewBook = Workbooks.Add On Error GoTo err_handler ThisWB.Worksheets("Summary").Range("A1:I100").Copy NewBook.Worksheets("Foglio1").Range("A1").PasteSpecial (xlPasteValues) NewBook.Worksheets("Foglio1").Range("A1").PasteSpecial (xlPasteFormats) NewBook.Worksheets("Foglio1").Range("A:J").Columns.AutoFit NewName = ThisWB.Path & "\" & NewBook.Worksheets("Foglio1").Range("A4").Value & "_Summary.xls" If Dir(NewName) "" Then If MsgBox("A file named '" & NewName & " already exists." & vbCr & vbCr & _ MeaName & " will now open??", vbYesNo) = vbYes Then Workbooks.Open NewName End If NewBook.Close False Exit Sub End If NewBook.SaveAs Filename:=NewName NewBook.ActiveSheet.Range("A1").Select NewBook.Close Application.ScreenUpdating = True err_handler: NewName = ThisWB.Path & "\" & NewBook.Worksheets("Foglio1").Range("A4").Value & "_Summary(error).xls" NewBook.SaveAs Filename:=NewName NewBook.ActiveSheet.Range("A1").Select NewBook.Close Application.ScreenUpdating = True End Sub