VBA добавит новый лист в закрытое excel без открытия и получит имя листа? Добавить лист vba
vba - Как добавить именованный лист в конце всех листов Excel
Попробуй это:
Private Sub CreateSheet() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets.Add(After:= _ ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ws.Name = "Tempo" End SubИли используйте предложение With , чтобы избежать неоднократного вызова вашего объекта
Private Sub CreateSheet() Dim ws As Worksheet With ThisWorkbook Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count)) ws.Name = "Tempo" End With End SubВыше может быть дополнительно упрощено, если вам не нужно вызывать на том же рабочем листе в остальной части кода.
Sub CreateSheet() With ThisWorkbook .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Temp" End With End SubПопробуй это:
Public Enum iSide iBefore iAfter End Enum Private Function addSheet(ByRef inWB As Workbook, ByVal inBeforeOrAfter As iSide, ByRef inNamePrefix As String, ByVal inName As String) As Worksheet On Error GoTo the_dark Dim wsSheet As Worksheet Dim bFoundWS As Boolean bFoundWS = False If inNamePrefix <> "" Then Set wsSheet = findWS(inWB, inNamePrefix, bFoundWS) End If If inBeforeOrAfter = iAfter Then If wsSheet Is Nothing Or bFoundWS = False Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = inName Else Worksheets.Add(After:=wsSheet).Name = inName End If Else If wsSheet Is Nothing Or bFoundWS = False Then Worksheets.Add(Before:=Worksheets(1)).Name = inName Else Worksheets.Add(Before:=wsSheet).Name = inName End If End If Set addSheet = findWS(inWB, inName, bFoundWS) ' just to confirm it exists and gets it handle the_light: Exit Function the_dark: MsgBox "addSheet: " & inName & ": " & Err.Description, vbOKOnly, "unexpected error" Err.Clear GoTo the_light End FunctionЕсли вы хотите проверить, существует ли лист с тем же именем, вы можете создать функцию:
Function funcCreateList(argCreateList) For Each Worksheet In ThisWorkbook.Worksheets If argCreateList = Worksheet.Name Then Exit Function ' if found - exit function End If Next Worksheet Worksheets.Add (After:=Worksheets(Worksheets.Count)).Name = argCreateList End FunctionЭто даст вам возможность:
- Перезаписать или сохранить вкладку с тем же именем.
- Поместите лист в конец всех вкладок или рядом с текущей вкладкой.
- Выберите свой новый лист или активный.
Excel VBA, как добавить имя исходного листа в скопированную строку на другом листе
Не уверен, что я буду использовать ActiveSheet.Name . ActiveSheet Selection.Parent.Name может быть лучше, так как ActiveSheet может меняться во время работы кода, но там снова может быть Selection .
Кроме того, добавление имени исходного листа в ячейку может перезаписать значение при копировании всей строки. Может быть, добавить его в качестве комментария?
Sub Move_Row() Dim sht1 As Worksheet Dim lastrow As Long Set sht1 = ThisWorkbook.Worksheets("Log") lastrow = sht1.Range("A" & sht1.Rows.Count).End(xlUp).Row With Selection.EntireRow .Copy Destination:=sht1.Cells(lastrow + 1, 1) .Delete End With With sht1.Cells(lastrow + 1, 1) If .Comment Is Nothing Then .AddComment .Comment.Text Text:="Source Sheet: " & Selection.Parent.Name Else .Comment.Text Text:=.Comment.Text & Chr(10) & "Source Sheet: " & Selection.Parent.Name End If End With End SubПримечание . Код фактически не выбирает EntireRow , он просто ссылается на него.
попробуйте это со следующими улучшениями скорости. Новая переменная назначается для отслеживания имени исходного файла и копируется в столбец C соответствующей строки в целевом листе.
Ваше решение:
Sub move_row() 'Declare variables Dim sht1 As Worksheet Dim lastRow As Long Dim strShtName as String 'name of active sheet 'Set variables Set sht1 = Sheets("Log") 'Select Entire Row Selection.EntireRow.Select 'assign name of active sheet strShtName = ActiveSheet.Name 'Move row to destination sheet & Delete source row lastRow = sht1.Range("A" & sht1.Rows.Count).End(xlUp).Row With Selection .Copy Destination:=sht1.Range("A" & lastRow + 1) .EntireRow.Delete End With 'put sheet name in column C sht1.Range("C" & lastRow + 1).Value = strShtName End Subvba - Как добавить информацию из vba на несколько листов
Private Sub CommandButton1_Click() Dim ctrl As control For Each ctrl In UserForm1.Controls If TypeName(ctrl) = "CheckBox" Then 'Pass this CheckBox to the subroutine below: TransferValues ctrl End If Next End Sub Sub TransferValues(cb As MSForms.CheckBox) Dim ws As Worksheet Dim emptyRow As Long Dim ws1 As Worksheet If cb Then 'Define the worksheet based on the CheckBox.Name property: Set ws = Sheets(Left(cb.Name, 15)) emptyRow = WorksheetFunction.CountA(ws.range("A:A")) + 1 With ws .Cells(emptyRow, 1).Value = surname.Value .Cells(emptyRow, 2).Value = firstname.Value .Cells(emptyRow, 3).Value = tod.Value .Cells(emptyRow, 4).Value = program.Value .Cells(emptyRow, 5).Value = email.Value .Cells(emptyRow, 6).Value = officenumber.Value .Cells(emptyRow, 7).Value = cellnumber.Value End With End If 'the master sheet needs to have a "Stakeholder" column with list of stakeholder the person belongs to End SubНапример, человек, названный John Doe, относится к 6/8 флажкам, над кодом передает всю информацию на 6/8 флажках. но я всегда хочу, чтобы информация была заполнена на главной вкладке с дополнительной стороной с именем столбца, которая будет передавать имена отмеченных ячеек. когда я попробовал, он сделал отдельную строку для каждого флажка вместо того, чтобы скомпилировать его в одну ячейку. поэтому я сделал 6 John Doe с той же информацией, за исключением того, что у каждого Джона Доу была другая заинтересованная сторона, к которой он принадлежал.
источник поделитьсяVBA: Добавить и удалить листы из списка
Я работаю над фрагментом кода, который создает копию определенного листа шаблона или удаляет лист на основе содержимого столбца в листе Excel, начиная с ячейки B2.
Действия Я хотел бы макрос, чтобы сделать:
1) Если имя листа соответствует значению массива ничего не делать 2) Если нет листа для элементов массива, создать копию шаблона листа и переименуйте значение массива. Далее, имя ячейки A1 скопированного листа в качестве значения массива. 3) Если в массиве нет листа, удалите лист. За исключением листов с именем Input или Template.
До сих пор у меня есть два отдельных кодов, один для копирования листов, а другой для удаления листов:
код для того, чтобы добавить листы:
Sub AddSheet() Application.ScreenUpdating = False Dim bottomA As Integer bottomA = Range("A" & Rows.Count).End(xlUp).Row Dim c As Range Dim ws As Worksheet For Each c In Range("A1:A" & bottomA) Set ws = Nothing On Error Resume Next Set ws = Worksheets(c.Value) On Error GoTo 0 If ws Is Nothing Then Sheets("Template").Select Sheets("Template").Copy After:=Sheets(Sheets.Count) ActiveSheet.name = c.Value End If Next c Application.ScreenUpdating = True End SubМои вопросы:
1) Как добавить элемент, который переименовывает ячейку A1 со значением массива в коде AddSheet?
2) Как добавить исключающие правила в код DeleteSheet?
3) Как я могу объединить эти коды в один код и, наконец, создать кнопку для активации этого макроса во входном листе?
Большое спасибо заранее!
stackoverrun.com
Добавить EventListener на новый лист vba MS Excel онлайн
Я собираюсь ответить на этот вопрос, потому что я думаю, что это может иметь некоторое отношение к довольно многим другим людям, поэтому приведенный ниже код поможет вам начать работу в правильном направлении.
Однако на этом сайте есть ожидание, что вы пытаетесь помочь себе хотя бы в той же степени, насколько мы пытаемся вам помочь. AddIns VBA Object Model , Application Events и AddIns . Не должно быть больше, чем большинство людей, чтобы исследовать эти ключевые слова (скажем, с поиском google). Это не совсем приемлемо просто сказать вам «не знаю, где поставить код или что делать», и, честно говоря, не особо мотивирует людей помочь вам – по-другому, вам очень повезло получить ответ с этим сообщением и комментарием.
Я не хочу вдаваться в огромный обмен комментариями точно, как закодировать ваш конкретный случай. Код здесь является примером, и я ожидаю, что вы затем изучите его дальше. Итак, здесь идет …
Вставьте модуль класса (исследование, которое, если вы не знаете, как) и назовите его – я назвал my cApp . Это позволит вам получить доступ к объекту Application и зафиксировать его события, например:
Option Explicit Private WithEvents mApp As Application Private mSheetList As Collection Private Sub Class_Initialize() Dim ws As Worksheet 'Create instance of the sheet collection Set mSheetList = New Collection 'If you wanted to add any existing sheets to be checked for changes, 'then you'd do it here. 'Just for an example, I'm using any existing sheets whose name contains "LoP". For Each ws In ThisWorkbook.Worksheets If InStr(ws.Name, "LoP") > 0 Then mSheetList.Add ws End If Next 'Create instance of Application Set mApp = Application End Sub Private Sub mApp_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim ws As Worksheet 'Test if the changed sheet is in our list. 'Check if the Sh object is a worksheet. If TypeOf Sh Is Worksheet Then 'Loop through out list of sheets and see if the Sh object is in the list. For Each ws In mSheetList If Sh Is ws Then 'Check if the changed range is in the desired range of your sheet. 'In this example, we'll say it has to been in the range "A1:B2". If Not Intersect(Target, ws.Range("A1:B2")) Is Nothing Then MsgBox ws.Name & "!" & Target.Address(False, False) & " has changed." End If Exit For End If Next End If End Sub Private Sub mApp_WorkbookNewSheet(ByVal Wb As Workbook, ByVal Sh As Object) 'A new sheet has been created so add it to our sheet list. If Wb Is ThisWorkbook Then If TypeOf Sh Is Worksheet Then mSheetList.Add Sh End If End If End SubЗатем вы вызываете процедуру RunMe где-то внутри вашего кода. Возможно, вы захотите сделать это в своем мероприятии Workbook_Open() , но это может быть где угодно по вашему выбору.
Я прокомментировал код довольно сильно, чтобы вы могли видеть, что он делает, и вы всегда можете исследовать каждое из ключевых слов, если не уверены, что они делают.
excel.bilee.com
добавление и удаление листов из списка MS Excel онлайн
Я работаю над фрагментом кода, который создает копию определенного листа шаблона или удаляет лист на основе содержимого столбца в листе Excel, начиная с ячейки B2.
Действия, которые я хотел бы сделать Макро:
1) Если имя листа соответствует значению массива, ничего не делайте 2) Если для значения массива нет листа, создайте копию листа шаблона и переименуйте его со значением массива. Далее, имя ячейки A1 скопированного листа в качестве значения массива. 3) Если есть лист, который не существует в массиве, удалите лист. За исключением листов с именем Input или Template.
До сих пор у меня есть два отдельных кода: один для копирования листов, а другой – для удаления листов:
Код для добавления листов:
Sub AddSheet() Application.ScreenUpdating = False Dim bottomA As Integer bottomA = Range("A" & Rows.Count).End(xlUp).Row Dim c As Range Dim ws As Worksheet For Each c In Range("A1:A" & bottomA) Set ws = Nothing On Error Resume Next Set ws = Worksheets(c.Value) On Error GoTo 0 If ws Is Nothing Then Sheets("Template").Select Sheets("Template").Copy After:=Sheets(Sheets.Count) ActiveSheet.name = c.Value End If Next c Application.ScreenUpdating = True End SubКод для удаления листов:
Sub DeleteSheet() Dim i As Long, x, wsAct As Worksheet Set wsAct = ActiveSheet For i = Sheets.Count To 1 Step -1 If Not Sheets(i) Is wsAct Then x = Application.Match(Sheets(i).name, wsAct.Range("A1:A20"), 0) If IsError(x) Then Application.DisplayAlerts = False Sheets(i).Delete Application.DisplayAlerts = True End If End If Next i End SubМои вопросы:
1) Как добавить элемент, который переименовывает ячейку A1 со значением массива в коде AddSheet?
2) Как добавить исключающие правила в код DeleteSheet?
3) Как я могу объединить эти коды в один код и, наконец, создать кнопку для активации этого макроса в листе ввода?
Спасибо заранее!
Solutions Collecting From Web of "VBA: добавление и удаление листов из списка"
Ну вот. Первое, что вам нужно сделать, это добавить параметр Compare Text в верхней части модуля для использования с Like Operator . Я должен комплимент вам, используя Range («A» и Rows.Count) .End (xlUp) .Row Это мой любимый метод для поиска max row. В качестве лучшей практики я рекомендую размещать все инструкции Dim в верхней части каждого Sub.
Сначала я решил выполнить удаление, потому что список Employee List не будет меняться во время процедуры, но количество рабочих листов, которые ему нужно пропустить, может быть уменьшено для дополнений. Ускорьте, где можете, не так ли? Приведенный ниже код будет захватывать имена сотрудников из столбца B (исключая B1) из таблицы ввода. Я назначил имена рабочих листов и шаблонов в качестве констант, так как они многократно используются через код. Таким образом, если вы когда-нибудь решите назвать их чем-то другим, вы не будете искать код.
Несмотря на то, что процедуры уже объединены здесь, мы могли бы легко вызвать другую процедуру с первого раза, поставив DeleteSheet в качестве последней строки AddSheet (). Это не требует использования Call в начале. Это было в первые дни Visual Basic, но не было уже давно. Дайте мне знать, если что-то неясно или не работает, как вам нравится.
Sub CheckSheets() Dim wksInput As Worksheet Dim wks As Worksheet Dim cell As Range Dim MaxRow As Long Dim NotFound As Boolean Dim Removed As String Dim Added As String 'Assign initial values Const InputName = "Input" Const TemplateName = "Template" Set wksInput = Worksheets(InputName) MaxRow = wksInput.Range("B" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False 'Delete worksheets that don't match Employee Names or are not Input or Template For Each wks In Worksheets NotFound = True 'Keep Input and Template worksheets safe If Not (wks.Name Like InputName Or wks.Name Like TemplateName) Then 'Check all current Employee Names for matches For Each cell In wksInput.Range("B2:B" & MaxRow) If wks.Name Like cell Then NotFound = False Exit For End If Next cell Else NotFound = False End If 'Match was not found, delete worksheet If NotFound Then 'Build end message If LenB(Removed) = 0 Then Removed = "Worksheet '" & wks.Name & "'" Else Removed = Removed & " & '" & wks.Name & "'" End If 'Delete worksheet Application.DisplayAlerts = False wks.Delete Application.DisplayAlerts = True End If Next wks 'Check each Employee Name for existing worksheet, copy from template if not found For Each cell In wksInput.Range("B2:B" & MaxRow) NotFound = True For Each wks In Worksheets If wks.Name Like cell Then NotFound = False Exit For End If Next wks 'Employee Name wasn't found, copy template If NotFound And LenB(Trim(cell & vbNullString)) <> 0 Then 'Build end message If LenB(Added) = 0 Then Added = "Worksheet '" & cell & "'" Else Added = Added & " & '" & cell & "'" End If 'Add the worksheet Worksheets(TemplateName).Copy After:=Worksheets(Worksheets.Count) ActiveSheet.Name = cell ActiveSheet.Range("A1") = cell End If Next cell 'Added here so user sees worksheets when the message displays Application.ScreenUpdating = True 'Final message touchups and display to user If LenB(Removed) <> 0 And LenB(Added) <> 0 Then Removed = Removed & " has been removed from the workbook." & vbNewLine & vbNewLine Added = Added & " has been added to the workbook." MsgBox Removed & Added, vbOKOnly, "Success!" ElseIf LenB(Removed) <> 0 Then Removed = Removed & " has been removed from the workbook." MsgBox Removed, vbOKOnly, "Success!" ElseIf LenB(Added) <> 0 Then Added = Added & " has been added to the workbook." MsgBox Added, vbOKOnly, "Success!" End If End Subexcel.bilee.com
VBA добавит новый лист в закрытое excel без открытия и получит имя листа? MS Excel онлайн
У меня есть excel "Closed.Xls", который не открывается в настоящее время.
Пожалуйста, дайте мне знать, как добавить новые листы в этот закрытый файл excel. Я знаю, как добавить новые листы в текущем excel.
Примечание. Я не хочу переименовывать лист.
Чтобы получить имя листа, используйте переменную worksheet , т.е.
Sub Added() Dim Wb As Workbook Dim ws As Worksheet With Application .ScreenUpdating = False .DisplayAlerts = False .EnableEvents = False End With Set Wb = Workbooks.Open("c:\Temp\closed.xls") Set ws = Wb.Sheets.Add Debug.Print ws.Name Wb.Save Wb.Close With Application .ScreenUpdating = True .DisplayAlerts = True .EnableEvents = True End With End SubЧто-то вроде этого будет делать то, что вы хотите. Это невозможно без открытия рабочей книги, но если вы отключите обновление экрана, это даст возможность не открываться.
Option Explicit Sub Add_Sheet_ClosedBook() Dim bk As Workbook Dim sh As Worksheet Dim shName As String With Application .ScreenUpdating = False .DisplayAlerts = False Set bk = .Workbooks.Open _ ("Path to Book.xls") End With With bk Set sh = .Sheets.Add shName = sh.Name .Save .Close End With With Application .ScreenUpdating = True .DisplayAlerts = True End With End SubМожно добавить лист, не открывая книгу, с помощью поставщика Microsoft.ACE.OLEDB.12.0:
set cn = new adodb.connection with cn .provider = "Microsoft.ACE.OLEDB.12.0" .connectionstring = "Data Source=" & strSomeFilename & ";Extended Properties=""Excel12.0;""" .open end with set cmd = new adodb.command cmd.activeconnection = cn cmd.commandtext = "CREATE TABLE MySheet (ID char(255))" cmd.executeЭто добавит заголовок «ID» в ячейку A1 нового листа. Вероятно, вы можете найти способ удалить / изменить его, если это необходимо.
excel.bilee.com
