Microsoft Excel

Herbers Excel/VBA-Archiv

VBA-Code in Sheet importieren


Betrifft: VBA-Code in Sheet importieren
von: Thorsten
Geschrieben am: 06.12.2018 21:33:25

Hallo,

ich brauche Hilfe..

Per Makro wird ein Dokument aus einem anderen Programm bearbeitet. Ich habe keinen Einfluss auf den VBA-Code in diesem Quell-Dokument.. Und genau das möchte ich ändern!

Wenn die Beabeitung des Dokumentes abgeschlossen ist, möchte ich die Eingabe in einige Zellen überwachen und entsprechend Programmcode laufen lassen.

Dazu ist mein Ansatz, dass ich den VBA-Code ins Dokument importiere. Das klappt soweit auch gut mit

ActiveWorkbook.VBProject.VBComponents.Import c:\temp\Module1.bas"

(gefunden hier im Forum: http://www.herber.de/forum/archiv/392to396/392488_Modul_entfernen_und_importieren_per_VBA.html)

Ich bekomme es aber nicht hin, dieses Modul direkt ans Sheet zu binden, so dass eine Überwachung der Zellen möglich wäre.

Hat hier jemand eine Idee, wie ich es in den entsprechenden Bereich lade und nicht in den "Modul"-Bereich?

Vielen Dank für Hilfe!

  

Betrifft: AW: VBA-Code in Sheet importieren
von: Ulrich
Geschrieben am: 07.12.2018 01:10:51

Hallo,

ich würde es direkt reinschreiben:

Sub Test()
'inspiriert von Nepumuk http:// _
www.office-loesung.de/ftopic229695_0_0_asc.php

Dim Wb As Workbook
Dim blnFound As Boolean, lngLine As Long

Set Wb = Workbooks.Open("c:\DeinPfad\DeineDatei.xlsm")

With Wb.VBProject.VBComponents("Tabelle1").CodeModule
    'Testen, ob es die Funktion bereits gibt
    For lngLine = 1 To .CountOfLines
        If .ProcOfLine(lngLine, 0) = "Worksheet_SelectionChange" Then
            blnFound = True
            Exit For
        End If
    Next
   
    If Not blnFound Then
        .InsertLines .CountOfLines + 2, _
               "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
        .InsertLines .CountOfLines + 1, "    msgbox ""hat geklappt"""
        .InsertLines .CountOfLines + 1, "End Sub"
    End If
End With

Wb.Close True

End Sub
Wenn du etwas mehr Code hast, dann würde ich natürlich eine Schleife über die Zeilen (zB. einer Textdatei) verwenden.
Oder du kannst auch mehrere in einem Rutsch einfügen:
http://www.office-loesung.de/ftopic229725_0_0_asc.php


Grüße, Ulrich


  

Betrifft: AW: VBA-Code in Sheet importieren
von: Hajo_Zi
Geschrieben am: 07.12.2018 05:52:49

in dem Link sehe ich keinen Code?

Option Explicit                                     ' Variablendefinition erforderlich
Option Private Module                               ' keine Anzeige in der Makroliste
Dim StDatei As String                               ' Variable Datei
' Zugrifff auf das VBA-Projekt muss zugelassen sein
Sub Code_Exportieren()
    Dim StZielPfad As Variant                       ' Ordner für Zieldatei
    Dim StZiel As String                            ' Variable Dateiname
    StDatei = ActiveWorkbook.Name
    StZielPfad = Application.GetOpenFilename("Exceldateien (*.xls*), *.xls*", _
        , "Zieldatei auswählen")
    If StZielPfad <> "" Or StZielPfad <> False Then
        ' Dateiname abtrennen
        StZiel = Mid(StZielPfad, InStrRev(StZielPfad, "\") + 1)
        If StZiel <> ActiveWorkbook.Name Then
            If InStr(UCase(StZiel), "XL") > 0 Then
                Application.DisplayAlerts = False   ' Mitteilungen aus
                Application.EnableEvents = False    ' Reaktion auf Eingabe aus
                Workbooks.Open StZiel               ' Zieldatei öffnen
'                On Error Resume Next                ' fehlerbehandlung aus
'                Workbooks(StZiel).Worksheets("Muster Vorlage").Visible = True
'                Workbooks(StZiel).Worksheets("Muster Vorlage").Delete
'                On Error GoTo 0                         ' Fehlerbehandlung Standard
'                Workbooks(StDatei).Worksheets("Muster Vorlage").Visible = True
'                Workbooks(StDatei).Worksheets("Muster Vorlage").Copy Before:=Workbooks(StZiel). _
Sheets(1)
'                Workbooks(StZiel).Worksheets("Muster Vorlage").Visible = xlVeryHidden
'                Workbooks(StDatei).Worksheets("Muster Vorlage").Visible = xlVeryHidden
'                Workbooks(StZiel).Worksheets("Muster Vorlage").Visible = xlVeryHidden
                Loeschen_Datei                       ' vorhandene Dateien löschen
                CodeLoeschen                         ' Code löschen
                ' Export des Codes
                alleMakrosExportieren Workbooks(StDatei).Name
                Import StZiel                       ' Import des Codes
                Workbooks(StZiel).Close True        ' sichern der Änderungen in Zieldatei
                Loeschen_Datei                      ' vorhandene Dateien löschen
                Application.EnableEvents = True     ' Reaktion auf Eingabe ein
                Application.DisplayAlerts = True    ' Mitteilungen ein
            End If
        Else
            MsgBox "Gleiche Datei"
        End If
    End If
End Sub

Sub Loeschen_Datei()
    On Error Resume Next                            ' Fehlerbehandlung nächste Anweisung
    Kill Workbooks(StDatei).Path & "\" & "*.bas"    ' vorhandene Moduldateien löschen
    Kill Workbooks(StDatei).Path & "\" & "*.FRM"    ' vorhandene UserFormdateien löschen
    Kill Workbooks(StDatei).Path & "\" & "*.CLS"    ' vorhandene Klassendateien löschen
    Kill Workbooks(StDatei).Path & "\" & "*.FRX"    ' vorhandene Dateien löschen
    On Error GoTo 0                                 ' Fehlerbehandlung Standard
End Sub

Sub CodeLoeschen()
    ' von Nepumuk, allen vorhandenen Code löschen, in Zieldatei
    Dim objVBComponents As Object
    With ActiveWorkbook.VBProject
        For Each objVBComponents In .VBComponents
            Select Case objVBComponents.Type
                Case 1, 2, 3
                    .VBComponents.Remove .VBComponents(objVBComponents.Name)
                Case 100
                    With objVBComponents.CodeModule
                        .DeleteLines 1, .CountOfLines
                    End With
            End Select
        Next
    End With
End Sub

Public Sub alleMakrosExportieren(StDateiExport As String)
    ' von Nepumuk, Export des gesamten Codes aus ThisWorkbook
    Dim vbc As Object, iCounter As Integer, cType As String
    For Each vbc In Workbooks(StDateiExport).VBProject.VBComponents
        With vbc.CodeModule
            For iCounter = 1 To .CountOfLines
                If .ProcOfLine(iCounter, 0) > "" Or InStr(1, .Lines(iCounter, 1), "Dim") <> 0 _
                    Or InStr(1, .Lines(iCounter, 1), "Public") <> 0 _
                        Or InStr(1, .Lines(iCounter, 1), "Type") <> 0 _
                        Or InStr(1, .Lines(iCounter, 1), "Static") <> 0 _
                        Or InStr(1, .Lines(iCounter, 1), "Declare") <> 0 Then
                    Select Case vbc.Type
                        Case 1: cType = ".bas"      ' Module
                        Case 2, 100: cType = ".cls" ' Tabelle; DieseArbeitsmape; Klassen
                        Case 3: cType = ".frm"      ' UserForm
                    End Select
                    ' Code Exportieren Ablagepath ThisWorkbook.Path
                    Workbooks(StDateiExport).VBProject.VBComponents(vbc.Name).Export _
                        Workbooks(StDatei).Path & "\" & vbc.Name & cType
                    Exit For
                End If
            Next iCounter
        End With
    Next vbc
End Sub

Public Sub Import(StDateiExport As String)
    ' von Nepumuk
    Dim vbc As Object, StDateiname As String
    With Workbooks(StDateiExport).VBProject
        ' Code importieren, UserForm korrekt, sonstiges alles in Klassenmodule
        StDateiname = Dir(Workbooks(StDatei).Path & "\" & "*.*")
        Do While StDateiname <> ""
            If UCase(Right(StDateiname, 4)) = ".BAS" Or UCase(Right(StDateiname, 4)) = ".FRM" _
                Or UCase(Right(StDateiname, 4)) = ".CLS" Then
                .VBComponents.Import Workbooks(StDatei).Path & "\" & StDateiname
            End If
            StDateiname = Dir
        Loop
        ' Code auf DieseArbeitsmappe und Tabellen (interner Name) verteilen
        For Each vbc In .VBComponents
            If vbc.Type = 2 Then
                ' alle Klassen beginnen mit cls und müssen nicht verteilt werden
                If UCase(Left(vbc.Name, 3)) <> "CLS" Then
                    ' Code an die entsprechenden Stelle kopieren
                    .VBComponents(Left(vbc.Name, Len(vbc.Name) - 1)).CodeModule.InsertLines 1,  _
_
                        vbc.CodeModule.Lines(1, vbc.CodeModule.CountOfLines)
                    ' Code in Klasse löschen
                    .VBComponents.Remove .VBComponents(vbc.Name)
               End If
            End If
        Next vbc
    End With
End Sub
GrußformelHomepage

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.


  

Betrifft: AW: VBA-Code in Sheet importieren
von: Thorsten
Geschrieben am: 07.12.2018 11:44:49

Danke für die Hilfe.

Ich habe es dann jetzt doch einfach darüber gelöst, dass ich alle Daten aus der externen Quelle in ein Excel-Dokument kopiere, welches ich unter Kontrolle habe. Dort liegt der Code dann vor, den ich brauche.

Dennoch vielen Dank und Gruß,
Thorsten