Mikael63 Postad 17 december, 2019 Share Postad 17 december, 2019 Kort historik bara: För rätt länge sedan hade jag en mjukvara som kunde söka och ersätta text i sidfoten/sidhuvudet på många Excelfiler, samtidigt. För inte fullt lika länge sedan laddade jag hem en demoversion (skarp version men utan licens) av samma mjukvara och använde den med, som jag minns gott resultat. När jag fick (tvingades få) en ny jobbardator hade jag inte behörighet (behörighetsfrågan är numera löst) att installera samma mjukvara på nytt. Jag beställde då denna mjukvara "officiellt" via vår IT. Det tog bara någon månad att få den och under tiden hade jag löst "uppgiften" på annat sätt. För några veckor sedan blev det ett behov av att använda denna mjukvara men den beter sig inte som jag minns det och därför blev det handpåläggning i stället. Idag åter samma behov och samma handpåläggning... ** Mjukvaran har det korta och kärnfulla namnet "Excel Find and Replace In Headers and Footers Software" från Sobolsoft. Eller "från" - det är väl mer en distributör antar jag och kanske därför som de inte svarar på e-post? https://www.sobolsoft.com/excelreplaceheader/ På den sidan finns en video och ca 11 sekunder in i den videon ser man hur gränssnittet ser ut. Så ser inte programmet ut idag: Där, i mitt program, återfinns "Save Results To This Folder" och det är där problemet finns. Jag vill att programmet ska spara den redigerade filen i sin ursprungliga mapp, oavsett var. Alltså skriva över befintlig fil. Antingen behövs ett helt annat program eller så, om det ens är möjligt, att kunna skriva något typ %=% eller så för att lura programmet. Eftersom detta är jobbrelaterat behöver inte programmet vara gratis men det måste finnas en fungerande demo/trial jag kan testa. Uppslag? Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 17 december, 2019 Share Postad 17 december, 2019 Fungerar programmet? Byter det ut sidfot/huvudelementet? Är bara problemet att det inte sparar på rätt plats? Det går säkert att lösa via hemhackat makro i en bok. Öppnar bok för bok, söker igenom, sparar. Länk till kommentar Dela på andra webbplatser More sharing options...
Mikael63 Postad 17 december, 2019 Trådskapare Share Postad 17 december, 2019 jadå programmet fungerar men det blir ett helsike att flytta in filer till sin rätta plats och dessutom kan det vara samma filnamn, fast i olika kataloger Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 17 december, 2019 Share Postad 17 december, 2019 Ett makro som löser det är nog inte så svårt att få till. Spelade in lite och se: With ActiveSheet.PageSetup .LeftHeader = "Vänster" .CenterHeader = "mitt" .RightHeader = "höger" .LeftFooter = "vänster fot" .CenterFooter = "mitt fot" .RightFooter = "höger fot" End With Med detta som grund, en filselektor och en loop som går igenom filerna, anropar derivat av det ovan, och sparar dem. Någon regel för vad som ska bytas ut och du har nog något som kan fungera. Vill du ha mer kod/hela koden för detta? Går det bra med makro för den delen? Mikael63 reagerade på detta 1 Länk till kommentar Dela på andra webbplatser More sharing options...
Mikael63 Postad 17 december, 2019 Trådskapare Share Postad 17 december, 2019 Ja, jag kan köra makro. Vilka filer som ska inkluderas varierar från gång till gång, jag behöver markera en (i sammanhanget) rot-mapp och sedan ska alla *.xls* i den mappen, och i alla underliggande mappar, sökas igenom efter en sträng, vanligen ett datum som ex. 2019-11-28 som ska bytas till ett annat ex. 2019-12-20 Länk till kommentar Dela på andra webbplatser More sharing options...
Solution Monshi Postad 17 december, 2019 Solution Share Postad 17 december, 2019 Okej, alltså peka ut en mapp Stega igenom hela mappen och alla undermappar. Öppna varje Excel-fil, leta efter ett givet värde och ersätta med ett annat. Spara denna fil med samma namn. Finns en risk att detta kan ett bra tag att göra men kan nog, om enkla böcker, kanske fås ned till någon sekund per bok. Om större böcker tar de ju tid att öppna. ... ... ... en stund senare en fil klar Testa den om du vågar. PÅ EN MINDRE MÄNGD FILER SOM START Den loopar igenom hela din disk om du vill men det skulle nog ta ett tag. Kan göra bättre startdialog, som fält du ska fylla i på bladet kanske? En dialog för att hämta sökväg och sedan en startknapp för själva loopen? Koden kan krascha och en kan poppa upp dialoger om exempelvis filerna som öppnas innehåller data från andra böcker. De ska gå att dölja vill jag minnas men inte fixat det i denna bok (Application.DisplayAlerts = False fixar det troligen) . Koden kanske inte den finaste men helt ok. var ett tag sedan jag hackade VBA-kod på detta vis (en timmas arbete att få ihop det) Koden (norpat och snott delar från nätet): Option Explicit Dim globalSearchFor As String Dim globalReplacewith As String Sub SearchReplace(searchFor As String, replaceWith As String, ws As Worksheet) With ws.PageSetup .LeftHeader = replace(.LeftHeader, searchFor, replaceWith) .CenterHeader = replace(.CenterHeader, searchFor, replaceWith) .RightHeader = replace(.RightHeader, searchFor, replaceWith) .LeftFooter = replace(.LeftFooter, searchFor, replaceWith) .CenterFooter = replace(.CenterFooter, searchFor, replaceWith) .RightFooter = replace(.RightFooter, searchFor, replaceWith) End With End Sub Sub LoopWorkbook(wb As Workbook) Dim ws As Worksheet For Each ws In wb.Worksheets SearchReplace globalSearchFor, globalReplacewith, ws Next ws End Sub Function GetFolder() As String Dim fldr As FileDialog Dim sItem As String Set fldr = Application.FileDialog(msoFileDialogFolderPicker) With fldr .Title = "Select a Folder" .AllowMultiSelect = False .InitialFileName = Application.DefaultFilePath If .Show <> -1 Then GoTo NextCode sItem = .SelectedItems(1) End With NextCode: GetFolder = sItem Set fldr = Nothing End Function Sub StartSub() Dim value value = InputBox("Sök efter") If value = "" Then Exit Sub globalSearchFor = value value = InputBox("Ersätt med") If value = "" Then Exit Sub globalReplacewith = value Dim folder As String folder = GetFolder If folder = "" Then Exit Sub Application.ScreenUpdating = False LoopAllSubFolders folder Application.ScreenUpdating = True End Sub Sub LoopAllSubFolders(ByVal folderPath As String) Dim filename As String Dim fullFilePath As String Dim numFolders As Long Dim folders() As String Dim i As Long If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" filename = Dir(folderPath & "*.*", vbDirectory) While Len(filename) <> 0 If Left(filename, 1) <> "." Then fullFilePath = folderPath & filename If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then ReDim Preserve folders(0 To numFolders) As String folders(numFolders) = fullFilePath numFolders = numFolders + 1 Else If isExcelFile(folderPath & filename) Then Debug.Print folderPath & filename Dim wb As Workbook On Error GoTo stepOver Set wb = Workbooks.Open(folderPath & filename) LoopWorkbook wb wb.Close True stepOver: End If End If End If filename = Dir() Wend For i = 0 To numFolders - 1 LoopAllSubFolders folders(i) Next i End Sub Function isExcelFile(filename As String) As Boolean isExcelFile = (InStr(1, filename, ".xl") > 0) End Function HuvudFotUpdate.zip Mikael63 reagerade på detta 1 Länk till kommentar Dela på andra webbplatser More sharing options...
Mikael63 Postad 17 december, 2019 Trådskapare Share Postad 17 december, 2019 Tusen tack! Jag körde den på min skarpa mapp (en kopia av) och lät den tugga igenom de 34 (excel)filer som fanns där. Nu ser jag till att spara denna och avinstallerar "mitt" program. En nyfiken fråga: Fungerar även jokertecken? Låt säga att jag vill ersätta 2018-??-?? med 2019-12-24. Eller jag kan ju testa men.. Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 18 december, 2019 Share Postad 18 december, 2019 Verkar inte fungera med den replace jag använder. Då får man nog snarare använda instr(...) för att se om strängen innehåller 2018 och då skriva in det nya datumet. Logiken i SearchReplace blir lite annorlunda, skulle säga gör det i egen funktion som: Sub test() Dim str As String str = "2018-01-01" str = partSearch(str, "2018", "2019-01-01") Debug.Print str End Sub Function partSearch(toSearch As String, searchFor As String, newValue As String) As String If InStr(1, toSearch, searchFor) > 0 Then partSearch = newValue Else partSearch = toSearch End If End Function Mikael63 reagerade på detta 1 Länk till kommentar Dela på andra webbplatser More sharing options...
Mikael63 Postad 21 december, 2019 Trådskapare Share Postad 21 december, 2019 På 2019-12-18 på 22:02, skrev Monshi: Verkar inte fungera med den replace jag använder. Då får man nog snarare använda instr(...) för att se om strängen innehåller 2018 och då skriva in det nya datumet. Logiken i SearchReplace blir lite annorlunda, ../.. Har inte kollat mer på detta, det blev liksom julledigt och Windowsdatorn åkte ner i "ryggan" men ledigheten torde bjuda på just ledig tid varför jag då kommer att kolla. Länk till kommentar Dela på andra webbplatser More sharing options...
Mikael63 Postad 26 december, 2019 Trådskapare Share Postad 26 december, 2019 Så, nu har jag sparkat liv i Windowsdatorn... Nu behöver jag guidning.. Ska jag byta ut något i den levererade filen med innehållet från inlägget den 18/12? Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 27 december, 2019 Share Postad 27 december, 2019 Inser när jag skriver ett nytt svar att koden INTE bör testas live. Det ovan fungerar inte som det ska. Ett anrop som str = partSearch("Fakturadatum 2018-01-01", "2018", "2019-01-01") Skulle ge resultatet "2019-01-01". Den byter ut hela strängen, hela fältet, vilket du nog inte vill. Måste ta detta tillbaka och ge dig en ny lösning. Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 27 december, 2019 Share Postad 27 december, 2019 Och mitt förslag blir nu Sub test() Dim str As String str = "bla bla 2018-01-01bla bla" str = regExpReplace(str, "2018\-\d\d-\d\d", "2019-01-01") Debug.Print str End Sub Function regExpReplace(toSearch As String, pattern As String, newValue As String) As String Dim objRegEx Set objRegEx = CreateObject("vbscript.regexp") objRegEx.Global = True objRegEx.IgnoreCase = True objRegEx.MultiLine = True objRegEx.pattern = pattern regExpReplace = objRegEx.replace(toSearch, newValue) End Function Men då måste nog dialogen skrivas om så att du kan få hjälp med söksträngen... ja, se bifogad bok. HuvudFotUpdate.zip Mikael63 reagerade på detta 1 Länk till kommentar Dela på andra webbplatser More sharing options...
Mikael63 Postad 27 december, 2019 Trådskapare Share Postad 27 december, 2019 Jamen det är ju lysande!! Fungerar helt perfekt och jag behåller även den förra, att användas när det inte är datum som ska ändras! Stort tack! Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 27 december, 2019 Share Postad 27 december, 2019 Kan slå ihop båda lösningarna till en och ett val hur sökningen ska ske kan ska skapas bättre gui även men jag ska nog säga att det är inte min bästa gren att skapa ett grafiskt gränssnitt. Länk till kommentar Dela på andra webbplatser More sharing options...
Mikael63 Postad 27 december, 2019 Trådskapare Share Postad 27 december, 2019 Äh, det duger jättefint som det är! Länk till kommentar Dela på andra webbplatser More sharing options...
Mikael63 Postad 24 april, 2020 Trådskapare Share Postad 24 april, 2020 (redigerade) Uppdatering! Upptäckte att detta inte fungerar om arbetsboken med makrot ligger i samma "huvudkatalog" som den som ska genomsökas. Måste ligga på samma nivå, eller över den som ska genomsökas. Redigerad 9 oktober, 2020 av Mikael63 fattar inte vad jag menade Länk till kommentar Dela på andra webbplatser More sharing options...
Rekommendera Poster