Leeres Codemodul per VBA generieren

Hallo Freunde,
Thema Weiterbildung! Ich taste mich peu à peu mit den VBComponents und Co. Habe etliche Proficodes gefunden die mich etwas überfordern. Ich möchte (momentan) lediglich ein neues Modul mittels VBA generieren im untenstehenden Beispiel.
Wer könnte mir weiter helfen?


Sub Uebertrage_Module()
Dim sSOURCE As String, sTARGET As String
sSOURCE = "QUELLE.XLS"
sTARGET = "ZIEL.XLS"
Call CopyCode(sSOURCE, sTARGET, "DieseArbeitsmappe")
Call CopyCode(sSOURCE, sTARGET, "DECLARATIONS")
Call CopyCode(sSOURCE, sTARGET, "C_COMBOXES")
Call CopyCode(sSOURCE, sTARGET, "MAIN")
End Sub



Sub CopyCode(sSOURCE, sTARGET, sMODULNAME)

'Gefunden im Forum von Office-Lösungen - Autor: Nepumuk

Dim objCodeModule As Object

Set objCodeModule = Workbooks(sSOURCE).VBProject.VBComponents(sMODULNAME).CodeModule

'if CodeModule nicht vorhanden dann stelle ein leeres Modul zur Verfügung

With Workbooks(sTARGET).VBProject.VBComponents(sMODULNAME).CodeModule

.DeleteLines 1, .CountOfLines

.InsertLines 1, objCodeModule.Lines(1, objCodeModule.CountOfLines)

End With

MsgBox (sMODULNAME & " wurde erfolgreich aktualisiert.")

End Sub

Mahlzeit!
Franz D.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Franz,

Sub CopyCode(sSOURCE, sTARGET, sMODULNAME)

  'Gefunden im Forum von Office-Lösungen - Autor: Nepumuk

  Dim objCodeModule As Object, objTargetModule As Object

  On Error Resume Next

  Set objCodeModule = Workbooks(sSOURCE).VBProject.VBComponents(sMODULNAME).CodeModule

  On Error GoTo 0

  If Not objCodeModule Is Nothing Then

    On Error Resume Next
    Set objTargetModule = Workbooks(sTARGET).VBProject.VBComponents(sMODULNAME).CodeModule
    On Error GoTo 0

    'if CodeModule nicht vorhanden dann stelle ein leeres Modul zur Verfügung

    If objTargetModule Is Nothing Then
      On Error Resume Next
      Set objTargetModule = Workbooks(sTARGET).VBProject.VBComponents.Add(objCodeModule.Parent.Type).CodeModule
      objTargetModule.Name = objCodeModule.Parent.Name
      On Error GoTo 0
    End If

    If Not objTargetModule Is Nothing Then
      With objTargetModule

        .DeleteLines 1, .CountOfLines

        .InsertLines 1, objCodeModule.Lines(1, objCodeModule.CountOfLines)

      End With

      MsgBox (sMODULNAME & " wurde erfolgreich aktualisiert.")
    End If
  End If

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Leeres Codemodul per VBA generieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread