Macros aus Textdatei in Excelmappe

Sub Modul_Vorwert_einfügen() On Error Resume Next Dim VBKomp As VBComponent Set VBKomp = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule) VBKomp.Name = "ModulVorwert" VBKomp.codeModule.AddFromFile ("K:\GCLabor\Macros\Excel-Macros für Labor Heppeler\Pharmabefunde\diese Macro nie löschen\ModVorwerte.txt") On Error GoTo 0 Application.Visible = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_Activate() 'dieses Activate Makro wurde durch das Add-In per Makro eingefügt Dim rngAktiveZelle As Range, Ende_der_Befund_Tabelle As String Application.ScreenUpdating = False On Error Resume Next If ActiveSheet.Name "Arbeitsunterlagen" Then ActiveSheet.Unprotect UserName = LCase(Environ("USERNAME")) Select Case UserName Case "josefine.hilpert", "kathrin.lais", "birte.philipp", "katrin.dilger", "felix", "angelika.hofer", "felix.heppeler", "axel.heppeler", "barbara.weber" Range("A1:G150").Select Selection.Locked = False Selection.Font.ColorIndex = xlColorIndexAutomatic Range("A1").Select Sheets(1).Select Case Else Range("A65536").Select Ende_der_Befund_Tabelle = ActiveCell.End(xlUp).Row Range(Range("A1"), Range("E" & Ende_der_Befund_Tabelle)).Select For Each rngAktiveZelle In ActiveSheet.UsedRange rngAktiveZelle.Select If Len(rngAktiveZelle) 0 Or rngAktiveZelle "" Then rngAktiveZelle.Select rngAktiveZelle.Font.ColorIndex = 5 rngAktiveZelle.Locked = True End If Next Sheets(1).Select Range("A1").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True If InStr(Application.ActiveWorkbook.Path, "PROBEN Erfassung") > 0 Then MsgBox ("Achtung, die Probe ist noch in der Datenerfassung. Analysenauftrag kann sich noch ändern") End If End Select End If Application.ScreenUpdating = True ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\system32\SHELLLNK.TLB" End Sub

Hallo Vincent,
das dynamisches Anbinden von Code kommt selten vor. Es ist abzuwägen, warum es notwendig sei.
Wie es scheint zu sein, versuchst Du damit einen Schreibsperre einzurichten, wenn der User nicht in der Liste steht.
Schon das wäre nicht optimal: es sollte grundsächlich schreibegeschützt sein und nur dann geöffnet, wenn der User aufgelistet ist und wenn er den Schreibrecht erst überhaupt verlangt.
Man kann die Datei im Modus "Schreibschutz empfehlen" einschalten: auf "Tools" neben "Speichern" beim "Speichern unter", dann "Allgemeine Optionen" und "schreibschutz empfehlen".
Zweitens: möchtest Du wirklich die Spielerei jedemal machen, wenn ein neue Kollege dazukommt?
Sind die Kollege so doof, dass man den Schreibrecht wegnehmen muss? Denk dran, dass Verantwortung zu übergeben die Motivation steigert.
Ausserdem kann man einem Netzlaufwerk so einrichten, dass jede Version einer Datei gespeichert wird. Da sieht man schnell, wer blödsinn gemacht hat und die Daten zurückspielen. (Verantwortung übergeben, Stufe 2, leider zwispältig, je nach dem wie es kommuniziert wird: "es wird entdeckt, wenn ich meiner Verantwortung nicht gerecht bin" oder "ich werde gerettet, falls es schief geht")
VG
Yal

Sorry leider hast du mich noch nicht verstanden.
Die Makros werden über ein AddIn selbst in viele Excelmappen geschrieben
Dieses ist aber für eine Pflege/Erweiterung der Makros viel zu aufwendig
Einfacher wäre es die Makros in "textBausteine" zu pflegen und dann über das AddIN einzufügen
Auszug des AddIn
With ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").codeModule
On Error GoTo error_1
x1 = .ProcBodyLine("Workbook_Activate", vbext_pk_Proc)
On Error GoTo 0
With ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").codeModule
On Error GoTo error_1
x1 = .ProcBodyLine("Workbook_Activate", vbext_pk_Proc)
On Error GoTo 0
Anzahl_der_Zeilen = .CountOfLines
continue_1:
x1 = .CreateEventProc("Activate", "Workbook")
.InsertLines x1 + 1, "'dieses Activate Makro wurde durch das Add-In per Makro eingefügt"
.InsertLines x1 + 2, " Dim rngAktiveZelle As Range, Ende_der_Befund_Tabelle as String"
.InsertLines x1 + 3, " Application.ScreenUpdating = False"
.InsertLines x1 + 4, " On Error Resume Next"
.InsertLines x1 + 5, Macrotext 'If ActiveSheet.Name "Arbeitsunterlagen" Then
.InsertLines x1 + 6, " ActiveSheet.Unprotect"
.InsertLines x1 + 7, Macrotext3 'UserName = LCase(Environ("USERNAME"))
.InsertLines x1 + 8, " Select Case UserName"
.InsertLines x1 + 9, Macrotext5 ' Case "julia.brunner", "renate.ruetsch", "sonja.throm", "angelika.hofer", "felix.heppeler", "axel.heppeler
.InsertLines x1 + 10, Macrotext7 ' Range("A1:G150").Select
.InsertLines x1 + 11, " Selection.Locked = False"
.InsertLines x1 + 12, " Selection.Font.ColorIndex = xlColorIndexAutomatic"
.InsertLines x1 + 13, Macrotext4 'Range("A1").Select
.InsertLines x1 + 14, " Sheets(1).Select"
.InsertLines x1 + 15, " Case Else"
.InsertLines x1 + 16, Macrotext9 ' Range("A65536").Select
.InsertLines x1 + 17, " Ende_der_Befund_Tabelle = ActiveCell.End(xlUp).Row"
.InsertLines x1 + 18, Macrotext2 'Range(Range("A1"), Range("D150").End(xlUp)).ColorIndex = xlColorIndexAutomatic
.InsertLines x1 + 19, " For Each rngAktiveZelle In ActiveSheet.UsedRange"
.InsertLines x1 + 20, " rngAktiveZelle.Select"
.InsertLines x1 + 21, Macrotext8 'If Len(rngAktiveZelle) 0 Or rngAktiveZelle "" Then
.InsertLines x1 + 22, " rngAktiveZelle.Select"
.InsertLines x1 + 23, " rngAktiveZelle.Font.ColorIndex = 5"
.InsertLines x1 + 24, " rngAktiveZelle.Locked = True"

Sub Modul_Vorwert_einfügen() Dim Pfad As String Dim VBKomp As Object Dim wb As Workbook Pfad = ThisWorkbook.Path & "\" Set wb = ActiveWorkbook On Error Resume Next Set VBKomp = wb.VBProject.VBComponents("DieseArbeitsmappe") With VBKomp.CodeModule ' Bisherigen Code ggf. löschen .DeleteLines Startline:=1, _ Count:=.CountOfLines ' Code aus Textdatei einfügen .AddFromFile Pfad & "ModVorwerte.txt" End With On Error GoTo 0 Application.Visible = True End Sub

Beliebteste Forumthreads (12 Monate)

Macros aus Textdatei in Excelmappe

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

42 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Macros aus Textdatei in Excelmappe

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

42 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread