23. februar 2006 - 00:30Der er
14 kommentarer og 1 løsning
samling af linier
Hej Eksperter.
Jeg har et felt i en access database hvor der står noget tekst der er delt over flere linier. Indholdet i feltet kan variere i antallet af linier. Record 1 kan feks bestå af 3 linier som vist i mit eksempel nedenfor. Andre felter kan have op til måske 50 linier i feltet.
Eks: [felt1] bilen er rød den kan køre stærkt med dette er også farligt
Spørgsmål: Jeg ville gerne at teksten først blev placeret på én samlet linie. Det vil sige udskifte linebreaket med en backtab
Eks: bilen er rød den kan køre stærkt med dette er også farligt
Dernæst ville jeg gerne lave en ombrydning af denne nye "1 linie" tekst således at der fra højre mod venstre blev talt karakterer, og efter hver 80' ende karakterer blev indsat et linebreak. Hvis linebreaket sker midt i et ord skal den ombryde teksten lige for det ord der normalt ville være blevet brudt således jeg ikke har en forkert orddeling.
eks. det er dejligt vejr i dag, og solen...bla bla...når månen kommer
Lad os antage at karakter nr 80 = "å" i ordet "månen". Da ville koden normalt bare ombryde til:
det er dejligt vejr i dag, og solen...bla bla...når må nen kommer
HEr er det den skal tage højde for dette og ombryde lige for ordet således det bliver til:
det er dejligt vejr i dag, og solen...bla bla...når månen kommer
NB. Da der jo kan være mange linier oprindeligt og dermed også mange karakterer, skal koden kunne "tælle" de 80 mere end 1 gang. Det vil sige at den starter fra højre i 1-linieteksten og bryder efter 80 (hvis dette ikke er midt i ordet..) dernæst tæller den igen 80 og bryder osv....
Jeg ville gerne give mere en 200 point men det er jo ikke længere muligt ;-(( Håber alligevel der er en sjæl der vil hjælpe mig om muligt...
Denne side indeholder artikler med forskellige perspektiver på Identity & Access Management i private og offentlige organisationer. Artiklerne behandler aktuelle IAM-emner og leveres af producenter, rådgivere og implementeringspartnere.
Måske kan du bruge nedenstående funktion som udfører og returnerer det ønskede i VBS (ok, den tilføjer delestreger, når linjeskift ikke er mulig på anden måde, men ellers... *S*). Den kaldes med den ønskede tekst og linjelængde, fx 'nytekst = MakeLineShift(gltekst, 80)':
Function MakeLineShift (txt, lineLength) tmp = Replace(txt, vbNewLine, " ") iLen = Len(tmp) iCount = 1 iOldLength = lineLength newStr = "" line = "" While (iCount + lineLength) < iLen iLastSpace = InStrRev(tmp, " ", iCount + lineLength) If iLastSpace > iCount Then lineLength = iLastSpace - iCount+ 1 Else line = "-" End If newStr = newStr & Mid(tmp,iCount,lineLength)& line & vbNewLine iCount = iCount + lineLength lineLength = iOldLength line = "" Wend newStr = newStr & Mid(tmp, iCount, lineLength) MakeLineShift = newStr End Function
Prøv at oprette en forspørgsel og med tag feltet ARTIKELTEKST. i en tom kolonne i denne forsprøgsel (´designvisnin)skal du skrive nedenstående:
Info: Erstat([ARTIKELTEKST];Chr(13)+Chr(10);" ")
Altså Info er et beregnet udtryk hvor du benytter Funktionen Repalce (Erstat)til at finde alle linjeskift og sætte teksten på en lang række. For hvert linjeskift kommer der så et mellem i teksten det er denne "" der gør det. Måske det er det du er ude efter ?
I koden optræder der 3 tabelfelter, som er defineret som Notat-felt.
Option Compare Database Private Sub Kommandoknap6_Click() 'udfør redigering Dim p, linie As String, part, ix, uRed As String linie = "" uRed = [Uredigeret]
[Redigeret] = "" [linie80] = ""
While InStr(uRed, vbCrLf) > 0 p = InStr(uRed, vbCrLf) If p > 0 Then linie = linie + Left(uRed, p - 1) + " " uRed = Mid(uRed, p + 2) End If Wend
[Redigeret] = linie + uRed
While Len([Redigeret]) > 80 ix = 80
While Mid([Redigeret], ix, 1) <> " " ix = ix - 1 Wend
jeg har også i mellemtidenm fået en af vore programmører til at kigge å opgaven og skal derfor teste vedlagte. Det skulle være bulletproof og kemplet.
Function MakeLineShift() '(txt, lineLength) Dim rs As DAO.Recordset Dim db As Database Set db = CurrentDb Set rs = db.OpenRecordset("Table1", dbOpenDynaset)
Dim rsFieldName As String rsFieldName = "test"
Dim breakLength As Integer breakLength = 80
Dim breakIdx As Integer
Dim replaceString As String replaceString = vbNewLine
While rs.EOF = False Dim helelinien As String If Len(rs.Fields(rsFieldName).Value) > 0 Then helelinien = rs.Fields(rsFieldName).Value breakIdx = breakLength If Len(helelinien) > breakIdx Then While breakIdx < Len(helelinien) If Mid(helelinien, breakIdx, 1) = " " Then Mid(helelinien, breakIdx, Len(replaceString)) = replaceString breakIdx = breakIdx + breakLength Else Dim i As Integer For i = breakIdx To 0 Step -1 If Mid(helelinien, i, 1) = " " Then Mid(helelinien, i, Len(replaceString)) = replaceString breakIdx = i + breakLength Exit For End If Next i End If Wend rs.Edit rs.Fields(rsFieldName).Value = helelinien rs.Update rs.MoveNext End If Else rs.MoveNext End If Wend rs.Close db.Close Dim res As String res = MsgBox("Finished", vbOKOnly) Exit Function
små rettelser. Dette wer testet og virker rigtig godt, men som tak for indlæg og tilsendt database fra supertekst kvitterer jeg med point.
Her er dog den resulterende kode jeg internt har fået lavet og som jeg vælger at anvende.
Function MakeLineShift() '(txt, lineLength) Dim rs As DAO.Recordset Dim db As Database Set db = CurrentDb Set rs = db.OpenRecordset("table1", dbOpenDynaset)
Dim rsFieldName As String rsFieldName = "new"
Dim breakLength As Integer breakLength = 80
Dim breakIdx As Integer
Dim replaceString As String replaceString = vbNewLine
While rs.EOF = False Dim helelinien As String If Len(rs.Fields(rsFieldName).Value) > 0 Then helelinien = rs.Fields(rsFieldName).Value breakIdx = breakLength If Len(helelinien) > breakIdx Then While breakIdx < Len(helelinien) If Mid(helelinien, breakIdx, 1) = " " Then helelinien = Mid(helelinien, 1, breakIdx) & Replace(helelinien, " ", replaceString, breakIdx, 1) breakIdx = breakIdx + breakLength Else Dim i As Integer For i = breakIdx To 0 Step -1 If Mid(helelinien, i, 1) = " " Then helelinien = Mid(helelinien, 1, i) & Replace(helelinien, " ", replaceString, i, 1) breakIdx = i + breakLength Exit For End If Next i End If Wend rs.Edit rs.Fields(rsFieldName).Value = helelinien rs.Update rs.MoveNext Else rs.MoveNext End If Else rs.MoveNext End If Wend rs.Close db.Close Dim res As String res = MsgBox("Finished", vbOKOnly) Exit Function
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
