запись в модуль листа

[gsg]

в очередной раз не помог "поиск"

все-таки как програмно записать код в модуль листа?

[alex77755]

Вот процедура создающаяя меню перехода по листам. В том числе и создающая процедуры для каждого пункта меню:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim L
Dim S As Object
Dim FI
Dim ТекстПроцедуры
Dim xlmodule As Workbook 'Object
Set xlmodule = ActiveWorkbook

'удаляем все макросы из Лист1  (других макросов сюда не ложить)
On Error Resume Next
For L = xlmodule.VBProject.VBComponents(1).CodeModule.CountOfLines To 1 Step -1
FI = Left(xlmodule.VBProject.VBComponents(1).CodeModule.Lines(L, 1), 17)
 Debug.Print xlmodule.VBProject.VBComponents(1).CodeModule.Lines(L, 1)
If FI = "Public Sub Налист" Then
 xlmodule.VBProject.VBComponents(1).CodeModule.DeleteLines L, 3
 End If
Next L
Application.CommandBars("Worksheet Menu Bar").Controls("Листы").Delete
Set S = Application.CommandBars("Worksheet Menu Bar")
With Application.CommandBars("Worksheet Menu Bar")
'Создание строки меню Файл
        With .Controls.Add(Type:=msoControlPopup)
                .Caption = "&Листы"
                With .Controls
                        For L = 1 To Sheets.Count
ТекстПроцедуры = "Public Sub Налист" & L & "()" & vbCrLf & "Sheets(" & """" & Sheets(L).Name & """" & ").Select" & vbCrLf & "End sub"
  xlmodule.VBProject.VBComponents(1).CodeModule.AddFromString ТекстПроцедуры
                         With .Add(Type:=msoControlButton)
                        .Caption = Sheets(L).Name
                        .OnAction = "ЭтаКнига.Налист" & L
                     End With
                Next L
                End With
        End With
End With
End Sub

[gsg]

спасибо. то, что нужно