V
Kenne kein VS-Admin. Und weiß auch nicht, wie ich sauber das normale File/Add so umbiegen könnte, daß es für meine Zwecke nutzbar ist.
Aber mir war ausreichend, das Makro mit nem Button zu verbinden und in die Iconleiste vom VS zu stopfen.
'******************************************************************************'
'* Copyright(c) 2002 Volkard Henkel *'
'* http://www.volkard.de *'
'******************************************************************************'
option explicit
function GetProject
if(Application.Projects.Count=0) then
MsgBox "No Projekts in Workspace",vbOKOnly+vbInformation
set GetProject=nothing
exit function
end if
if(Application.Projects.Count=1) then
set GetProject=Application.ActiveProject
exit function
end if
do
Dim vProjectName
vProjectName=InputBox("Name of Projekt","MakeClass",Application.ActiveProject.Name)
if vProjectName="" then
set GetProject=nothing
exit function
end if
dim i
For Each i in Application.Projects
if(i.Name=vProjectName) then
set GetProject=i
exit function
end if
next
loop 'endlos
end function
function MakeUid
dim i,vResult
for i=1 to 8
vResult=vResult+chr(int(asc("0")+rnd*10))
next
MakeUid=vResult
end function
function FindConfigFile(vFso,vProjectFolder,vName,vExt)
dim vConfigFolder
set vConfigFolder=vProjectFolder
if vFso.FileExists(vConfigFolder.Path&"\"&vName&vExt) then
MsgBox "File existiert",vbOKOnly+vbInformation
set FindConfigFile=nothing
exit function
end if
if vFso.FileExists(vConfigFolder.Path&"\"&"default"&vExt&".cfg") then
set FindConfigFile=vFso.GetFile(vConfigFolder.Path&"\"&"default"&vExt&".cfg")
exit function
end if
set vConfigFolder=vConfigFolder.ParentFolder
do until vConfigFolder.IsRootFolder
if vFso.FileExists(vConfigFolder.Path&"\"&vName&vExt&".cfg") then
set FindConfigFile=vFso.GetFile(vConfigFolder.Path&"\"&vName&vExt&".cfg")
exit function
end if
if vFso.FileExists(vConfigFolder.Path&"\"&"default"&vExt&".cfg") then
set FindConfigFile=vFso.GetFile(vConfigFolder.Path&"\"&"default"&vExt&".cfg")
exit function
end if
set vConfigFolder=vConfigFolder.ParentFolder
loop
if vConfigFolder.IsRootFolder then
MsgBox "Could not find File",vbOKOnly+vbCritical
set FindConfigFile=nothing
end if
end function
Sub ProcessConfigFile(vStream,vClass,vUid)
dim vLine
do while not vStream.AtEndOfStream
vLine=vStream.ReadLine
vLine=replace(vLine,"UID",vUid)
vLine=replace(vLine,"Class",vClass)
vLine=replace(vLine,"CLASS",UCase(vClass))
ActiveDocument.Selection=vLine
ActiveDocument.Selection.NewLine
ActiveDocument.Selection.StartOfLine
loop
ActiveDocument.Selection.FindText "CURSOR",dsMatchFromStart
ActiveDocument.Selection.Delete
end sub
Sub MakeFile(vProject,vUid,vClass,vExt)
dim vFso,vFile,vProjectFolder,vStream
set vFso=CreateObject("Scripting.FileSystemObject")
set vProjectFolder=vFso.GetFile(vProject.FullName).ParentFolder
set vFile=FindConfigFile(vFso,vProjectFolder,vClass,vExt)
if vFile is nothing then
exit sub
end if
Set vStream=vFile.OpenAsTextStream(1,0)
if vStream.AtEndOfStream then
exit sub
end if
vProject.AddFile vClass&vExt
Documents.Add "Text"
ProcessConfigFile vStream,vClass,vUid
ActiveDocument.Save vProjectFolder&"\"&vClass&vExt
end sub
Sub MakeClass()
dim vProject
set vProject=GetProject()
if vProject is nothing then
exit sub
end if
if vProject.Type<>"Build" then
MsgBox "No Build Project",vbOKOnly+vbCritical
exit sub
end if
dim vClass
vClass=inputbox("Name of Class","MakeClass")
if vClass="" then
exit sub
end if
dim vUid
vUid=MakeUid
MakeFile vProject,vUid,vClass,".cpp"
MakeFile vProject,vUid,vClass,".h"
End Sub