Macro per creare unaltra macro

Hai un problema con Excel?

Nuova discussione

di alfrimpa data: 30/11/2015 12:07:54
Ciao Marnevi

Per onestà ti dico che il codice che vedi qui sotto non è mio ma preso dal sito CPearson al seguente link h t t p://www.cpearson.com/excel/vbe.aspx che ti invito a consultare per gli approfondimenti del caso.

Io ho solo aggiunto le ultime quattro righe dove associo la macro "pippo" al pulsante "Button 1" (controllo modulo non ActiveX) presente sul foglio1.

La macro per funzionare necessita dell'attivazione in Strumenti, Riferimenti della libreria Microsoft Visual Basic For Applications Extensibility 5.3; se non lo fai avrai un errore di compilazione.

Spero ti sia d'aiuto.

Alfredo

Sub AddProcedureToModule()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Const DQUOTE = """" ' one " character

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Modulo1")
        Set CodeMod = VBComp.CodeModule
        
        With CodeMod
            LineNum = .CountOfLines + 1
            .InsertLines LineNum, "Public Sub pippo()"
            LineNum = LineNum + 1
            .InsertLines LineNum, "    MsgBox " & DQUOTE & "Ciao" & DQUOTE
            LineNum = LineNum + 1
            .InsertLines LineNum, "End Sub"
        End With
            ActiveSheet.Shapes("Button 1").Select
    Selection.OnAction = "pippo"
    Range("A1").Select
    End Sub

di marnevi (utente non iscritto) data: 30/11/2015 12:37:46
Grazie per la risposta!
Ho attivato la libreria che mi hai suggerito, purtroppo alla seguente riga mi dà l'errore "Errore di run-time '1004': L'accesso a livello di programmazione al Progetto Visual Basic non è attendibile"
Set VBProj = ActiveWorkbook.VBProject
di alfrimpa data: 30/11/2015 12:46:34
Mah non saprei che dirti.

Questo (la programmazione dell'editor di Visual Basic) è un argomento che non ho mai "frequentato"; ricordavo questo link e te l'ho segnalato.

Ma prima di risponderti ho ovviamente provato il codice ed a me ha funzionato.

A naso direi che l'errore che ricevi non è relativo al codice ma ad un qualcosa di più generale ma di più non saprei cosa ipotizzare.

Spero che intervenga qualcun altro che ha avuto modo di approfondire questi temi.

Alfredo

P.S. Prova a dare uno sguardo a questo link h t t p s://msdn.microsoft.com/it-it/library/tt6cbe57.aspx

di marnevi (utente non iscritto) data: 30/11/2015 16:59:07
grazie per i preziosi suggerimenti.
Era anche necessario andare in "Sicurezza macro" e spuntare "Considera attendibile l'accesso al progetto Visual Basic"
Ad ogni modo, ecco il codice funzionante. Grazie tante Alfrimpa!!!

Sub AddProcedureToModule()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Const DQUOTE = """" ' one " character

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Modulo1")
        Set CodeMod = VBComp.CodeModule
        
        With CodeMod
            LineNum = .CountOfLines + 1
            .InsertLines LineNum, "Public Sub pippo()"
            LineNum = LineNum + 1
            .InsertLines LineNum, "    MsgBox " & DQUOTE & "Ciao" & DQUOTE
            LineNum = LineNum + 1
            .InsertLines LineNum, "End Sub"
        End With
    ActiveSheet.Buttons.Add(2.25, 2.25, 43.5, 12.75).Select
    Selection.OnAction = "pippo"
    Selection.Characters.Text = "pippo"
    With Selection.Characters(Start:=1, Length:=5).Font
        .Name = "Calibri"
        .FontStyle = "Normale"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("B1").Select
    End Sub

di marnevi (utente non iscritto) data: 30/11/2015 17:13:03
Un ultima domanda. Come faccio ad inserire nel codice, al comando .InsertLines LineNum, la seguente istruzione senza che mi dia errore?
Application.Run ("'" & sPath & "Cartagg.xla'!aggiungi")

di marnevi (utente non iscritto) data: 30/11/2015 17:27:19
ok risolto. Si fa così:

.InsertLines LineNum, "Application.Run (""'"" & sPath & ""Cartagg.xla'!aggiungi"")"

Rilancio
di Andrea (utente non iscritto) data: 02/12/2015 12:45:59
Ciao Ragazzi,
anche a me serviva una cosa simile, ma aggiungo uno step in più. Io dovrei copiare in automatico il Muodulo2 su altro file, qui sotto le mie procedure.

Apro il "File_A" contenente il Modulo1 che ha una macro che Genera il "File_B".

A questo punto vorrei copiare il Modulo2 contenuto nel "File_A" sul "File_B", tutto ovviamente in automatico.

E' una cosa possibile?

Grazie 1000
Gentilissimi come al solito.

Ciao Andrea
di alfrimpa data: 02/12/2015 13:47:07
Ciao Andrea

Personalmente non so risponderti ma "googlando" ho trovato questo link

h t t p://forum.aiutamici.com/yaf_postst80277_Excel-2007-Copiare-n-moduli-macro-in-un-altro-file.aspx

Non so se ti può essere utile.

Alfredo

di marnevi (utente non iscritto) data: 08/12/2015 12:18:33
circa la seguente macro, come è possibile destinare la nuova macro che essa realizza in un modulo già esistente, ma all'interno di un altro progetto vba diverso da quello che ospita la seguente macro? Grazie.

Sub AddProcedureToModule()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Const DQUOTE = """" ' one " character

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Modulo1")
        Set CodeMod = VBComp.CodeModule
        
        With CodeMod
            LineNum = .CountOfLines + 1
            .InsertLines LineNum, "Public Sub pippo()"
            LineNum = LineNum + 1
            .InsertLines LineNum, "    MsgBox " & DQUOTE & "Ciao" & DQUOTE
            LineNum = LineNum + 1
            .InsertLines LineNum, "End Sub"
        End With
    ActiveSheet.Buttons.Add(2.25, 2.25, 43.5, 12.75).Select
    Selection.OnAction = "pippo"
    Selection.Characters.Text = "pippo"
    With Selection.Characters(Start:=1, Length:=5).Font
        .Name = "Calibri"
        .FontStyle = "Normale"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("B1").Select
    End Sub

di patel data: 08/12/2015 14:04:31
basta aprire il file ed utilizzare quello invece che quello attivo

Sub AddMacroToOtherWorkbook()
   Dim LineNum As Long
   Const DQUOTE = """" ' one " character
   Set wbOpen = Workbooks.Open("F:prova.xlsm")
   Set VBProj = wbOpen.VBProject
   Set VBComp = VBProj.VBComponents("Modulo1")
   Set CodeMod = VBComp.CodeModule
   With CodeMod
            LineNum = .CountOfLines + 1
            .InsertLines LineNum, "Public Sub pippo()"
            LineNum = LineNum + 1
            .InsertLines LineNum, "    MsgBox " & DQUOTE & "Ciao" & DQUOTE
            LineNum = LineNum + 1
            .InsertLines LineNum, "End Sub"
   End With
   wbOpen.Close True
End Sub

di marnevi (utente non iscritto) data: 09/12/2015 11:46:54
funziona... grazie

Vuoi Approfondire?