anoniem Geplaatst: 20 mei 2005 Delen Geplaatst: 20 mei 2005 Wie weet de oplossing voor onderstaand probleem? Omdat ik dit eigenlijk z.s.m. moet regelen, zal ik aan degene die het eerst de juiste oplossing aanlevert (uiterlijk zaterdag 21/5) een beloning hiervoor overmaken. Vanuit Word 2003 via Nieuwe macro opnemen, heb ik onderstaande macro gemaakt, waarmee ik uit een groot bestand verschillende nieuwe bestanden wil maken met ongeveer 300 bestandsnamen die de naam hebben van een naar het clipboard gekopieerde tekst uit het grote document. Het probleem is echter dat bij opslaan als... het bij de eerste keer uitvoeren van de macro wel de juiste bestandsnaam (CPR_MT_k4m2)wordt geplakt, maar bij de volgende keer uitvoeren van de macro gebeurt dit weer en wordt niet de inhoud van het clipboard (DNG_EN_gh5c) als bestandsnaam geplakt, maar weer de eerste bestandsnaam. Als ik via de VB-editor kijk, zie ik ook keihard de naam van het eerste bestand staan, terwijl hier dus eigenlijk de inhoud van het clipboard moet worden geplakt. Wie weet de oplossing? Alvast hartelijk dank! Het hoofdbestand bevat bijvoorbeeld de volgende tekst: CPR_MT_k4m2 number-to-string-padded ( exam 003 Naam 1|M| 007 Naam 2|V| 011 Naam 3|M| 012 Naam 4|M| etc... DNG_EN_gh5c number-to-string-padded ( exam 001 Naam 25|V| 013 Naam 26|V| 014 Naam 27|M| 023 Naam 28|V| etc... De macro: Selection.Find.ClearFormatting With Selection.Find .Text = "number-to" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.Find.Execute Selection.MoveUp Unit:=wdLine, Count:=1 Selection.HomeKey Unit:=wdStory, Extend:=wdExtend Selection.Cut Documents.Add DocumentType:=wdNewBlankDocument Selection.PasteAndFormat (wdPasteDefault) Selection.HomeKey Unit:=wdStory Selection.MoveDown Unit:=wdLine, Count:=1 Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.MoveUp Unit:=wdLine, Count:=1 Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.Copy Selection.Delete Unit:=wdCharacter, Count:=1 ActiveDocument.SaveAs FileName:="CPR_MT_k4m2.txt", FileFormat:= _ wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True, _ WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False, Encoding:=850, InsertLineBreaks:=False, AllowSubstitutions:=False, _ LineEnding:=wdCRLF ActiveDocument.Close End Sub Quote Link naar reactie
anoniem Geplaatst: 21 mei 2005 Auteur Delen Geplaatst: 21 mei 2005 Misschien een duwtje in de goede richting: het onderstaande vond ik in dit forum om meerdere bestanden aan te maken. Nu alleen nog de waarde van x zien te vervangen door de inhoud van het clipboard. Wie? Sub veelbestanden() For x = 1 To 400 bestandnaam = "c:\padnaam\nieuw" & CStr(x) & ".txt" ActiveDocument.SaveAs FileName:=bestandnaam, FileFormat:= _ wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True, _ WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False Next x End Sub Quote Link naar reactie
anoniem Geplaatst: 21 mei 2005 Auteur Delen Geplaatst: 21 mei 2005 Probleem opgelost met de volgende macro: Sub Macro1() ' ' Macro1 Macro ' Macro recorded 5/21/2005 by *** ' Selection.Find.ClearFormatting With Selection.Find .Text = "number-to" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.Find.Execute Selection.MoveUp Unit:=wdLine, Count:=1 Selection.HomeKey Unit:=wdStory, Extend:=wdExtend Selection.Cut Documents.Add DocumentType:=wdNewBlankDocument Selection.PasteAndFormat (wdPasteDefault) Selection.HomeKey Unit:=wdStory Selection.MoveDown Unit:=wdLine, Count:=1 Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.MoveUp Unit:=wdLine, Count:=1 Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection.Copy Load UserForm1 Unload UserForm1 Selection.Delete Unit:=wdCharacter, Count:=1 ActiveDocument.SaveAs FileName:=strtext, FileFormat:= _ wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True, _ WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False, Encoding:=850, InsertLineBreaks:=False, AllowSubstitutions:=False, _ LineEnding:=wdCRLF ActiveDocument.Close End Sub en de volgende userform: Attribute VB_Name = "UserForm1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub UserForm_Initialize() Set MyData = New DataObject MyData.GetFromClipboard strtext = Trim(MyData.GetText(1)) End Sub Private Sub UserForm_Terminate() Set MyData = Nothing End Sub Quote Link naar reactie
Aanbevolen berichten
Om een reactie te plaatsen, moet je eerst inloggen