I have built a report within MS Access which includes a short textbox that contains web addresses. The textbox has the "CanGrow" option set to "Yes".
Because there is limited horizontal space on the report for this field, and web addresses can be very long, rather than just having the web address spill over where ever the text length forces it to such as:
http://stackoverflow.com/que
stions/ask
I am wondering if there is a way to force the text string to word wrap at the last appropriate character, in this case the "/" character. The result would be something that looks more readable such as:
http://stackoverflow.com/
questions/ask
Can this be done? Any suggestions on how to approach this task?
The following recursive function will insert a carriage-return/line-feed based on user-defined characters and a max line length. This will work best with a fixed-width font, but with some experimentation should also be acceptable for a variable width font:
Function PrettyBreak(Txt As String, MaxCharsPerLine As Long, _
Optional BreakAfterChars As String = ":=-+&?./ ") As String
Dim t As String, i As Integer, Pos As Integer
If Len(Txt) > MaxCharsPerLine Then
t = Left(Txt, MaxCharsPerLine)
For i = MaxCharsPerLine To 1 Step -1
If InStr(BreakAfterChars, Mid(t, i, 1)) <> 0 Then
Pos = i
Exit For
End If
Next i
If Pos = 0 Then
PrettyBreak = t & vbCrLf & _
PrettyBreak(Mid(Txt, MaxCharsPerLine + 1), _
MaxCharsPerLine, BreakAfterChars)
Else
PrettyBreak = Left(t, Pos) & vbCrLf & _
PrettyBreak(Mid(Txt, Pos + 1), _
MaxCharsPerLine, BreakAfterChars)
End If
Else
PrettyBreak = Txt
End If
End Function
In use:
?prettybreak("http://stackoverflow.com/questions/5583986/ms-access-report-line-break-at-character", 30)
http://stackoverflow.com/
questions/5583986/ms-access-
report-line-break-at-character
Related
I need help at Auto-Incrementing a letter.
A description field in Table1 has values like: B39
This Table1 Record, has related records in Table2:
B39_a
B39_b
B39_c
B39_d
All I want to do is that the description in Table2 automatically takes the record at table1 and adds the specific letter. It always starts with "a" and never reaches the full alphabet.
I already tried some code from this site: http://www.freevbcode.com/ShowCode.asp?ID=5440
Function IncrementString(ByVal strString As String) As String
'
' Increments a string counter
' e.g. "a" -> "b"
' "az" -> "ba"
' "zzz" -> "aaaa"
'
' strString is the string to increment, assumed to be lower-case alphabetic
' Return value is the incremented string
'
Dim lngLenString As Long
Dim strChar As String
Dim lngI As Long
lngLenString = Len(strString)
' Start at far right
For lngI = lngLenString To 0 Step -1
' If we reach the far left then add an A and exit
If lngI = 0 Then
strString = "a" & strString
Exit For
End If
' Consider next character
strChar = Mid(strString, lngI, 1)
If strChar = "z" Then
' If we find Z then increment this to A
' and increment the character after this (in next loop iteration)
strString = Left$(strString, lngI - 1) & "a" & Mid(strString, lngI + 1, lngLenString)
Else
' Increment this non-Z and exit
strString = Left$(strString, lngI - 1) & Chr(Asc(strChar) + 1) & Mid(strString, lngI + 1, lngLenString)
Exit For
End If
Next lngI
IncrementString = strString
Exit Function
End Function
Apparently it is not working like it should. It increases the letter, but twice! (i , i , j , j , etc.)
Description textbox (for Table2 Record ) has as default value:
=IncrementString(DLast("[SeqNo]","[table2]"))
But like I said it increases the number by doing it double. I also have to start the process manually by entering an "a".
Neither the function nor the calling code presently allows for the "A##_" prefix. If you really MUST save this prefix to Table2, code would have to be adjusted to deal with it. As is, suggest not saving the "A##" group identifier as a prefix in Table2. Use a query that joins tables on PK/FK fields to retrieve related data for export.
The DLast() search must account for the "A##" group identifier because the sequence is repeated for each group.
Unfortunately, trying to set a DefaultValue property with a dynamic parameter dependent on main form ID is impractical. For one thing, subform loads before main form so the default value cannot be built since the main form data and controls are not available. Also, when the main form is moved to a new record, again there is no data for the default value to build with. The result is error displays for the control on new record row.
Use PK/FK fields for the search.
Code in subform Current event to call your incrementing function:
If Me.NewRecord And Not IsNull(Me.Parent.ReferenzNR) Then
Me!SerienBezeichnung = IncrementString(Nz(DLast("SerienBezeichnung", "tbl_GrundminenSerie", "ID_FK=" & Me.Parent.ReferenzID), ""))
End If
Be aware that DLast(), even though working now, could eventually fail because records do not have inherent order. An alternative would likely involve a recordset or nested domain aggregate. Example tested in VBA Immediate Window:
?DMax("SerienBezeichnung","tbl_GrundminenSerie","ID_FK=5 AND Len([SerienBezeichnung])=" & DMax("Len([SerienBezeichnung])","tbl_GrundminenSerie","ID_FK=5"))
Or if you feel autonumber PK can be depended on to always be increasing (which has always been my observation although there is no guarantee with autonumber):
?DLookup("SerienBezeichnung","tbl_GrundminenSerie","ID_FK=5 AND SerienID=" & DMax("SerienID","tbl_GrundminenSerie","ID_FK=5"))
Consider the following VBA function:
Function IncAlpha(ByVal strA As String, ByVal lngI As Long) As String
If lngI <= 0 Then
IncAlpha = strA
ElseIf strA = vbNullString Then
IncAlpha = IncAlpha("a", lngI - 1)
Else
lngI = lngI + Asc(Right(strA, 1)) - 97
IncAlpha = IncAlpha(Left(strA, Len(strA) - 1), lngI \ 26) & Chr(97 + lngI Mod 26)
End If
End Function
Supplied with a lowercase alphabetical string, this recursive function will increment the string by the supplied long integer argument, with z incrementing to aa, az incrementing to ba and so on.
Supplied with an empty string (""), the above function will return a.
?IncAlpha("", 1)
a
?IncAlpha("", 26)
z
?IncAlpha("", 27)
aa
?IncAlpha("", 42)
ap
?IncAlpha("", 314159)
qvsa
With this function, the suffix may therefore be calculated using:
<prefix> & IncAlpha("", DCount("[SeqNo]","[table2]") + 1)
Or to account for multiple prefixes:
<prefix> & IncAlpha("", DCount("SeqNo","table2","SeqNo like '" & <prefix> & "*'") + 1)
I want to add hyphenation to the column headers of a tablix
Consider the column value "waterbodiesinhereforme"
Currently SSRS is hyphenating based on the size it can fit inside the tablix column header. Like below .
waterbodiesinhereforme
But my requirement is
waterbodiesin-
hereforme
So far I have tried the soft hyphen character , which did not work in the ssrs even though html rendering was set to true. Even the Unicode "00AD" did not work.
When I tried with the ZeroWidthCharacter it worked correctly, but I do not know how to introduce a hyphen when there is a new line.
Zero Width Character Example
="water" + ChrW(&h200B) + "bodies" + ChrW(&h200B) + "in" + ChrW(&h200B) + "here" + ChrW(&h200B) + "for" + ChrW(&h200B) + "me"
Things I cannot do
- Hardcode the hyphen (not acceptable because this value is dynamic)
I've written this in Excel VBA, but this can be easily transferred to SSRS.
This splits the input string into parcels of 10 characters separated by carriage returns. You can change the string length by changing the initial value of IntSplit. You could add your zerowidthcharacter if you wanted. The Function code would need to be added to the "Report Properties>Code" section of the SSRS, with the string requiring the split being placed in the Expression for the field:
=code.SplitString(Fields!YourFieldName.value)
Here's the code ...
Private Sub do_it()
Dim strString As String
Dim StrNewString As String
strString = "This is a very long sentence that needs to be chunked up"
strString = SplitString(strString)
Debug.Print strString
End Sub
Private Function SplitString(ByVal strInput As String) As String
Dim StrOut As String
Dim IntSplit As Integer
Dim Intstart As Integer
Dim j As Integer
IntSplit = 10
Intstart = 1
StrOut = ""
For j = 1 To Len(strInput)
If Int(j / IntSplit) = j / IntSplit Then
StrOut = StrOut + Mid(strInput, Intstart, IntSplit) + vbCrLf
Intstart = j + 1
End If
Next
StrOut = StrOut + Mid(strInput, Intstart, Len(strInput) - (Intstart - 1))
SplitString = StrOut
'Return SplitString ' A Return statement is required in SSRS
End Function
Output
This is a
very long
sentence t
hat needs
to be chun
ked up
I'm trying to make it possible for the data stored in a MSSQL database to be encrypted/decrypted in both Access 2013 as well as ColdFusion. The Access database uses vba to sync data to the SQL database and I've found a few possible solutions for encryption but can't seem to get the results to match the same thing encrypted in ColdFusion.
www.ebcrypt.com appears to be the easiest but when I encrypt with either Blowfish, RIJNDAEL or any of the other methods, the results are not the same as what I encrypt in ColdFusion.
I decided to try to use the native CryptoAPI but the same thing happens when I try to match what vba is doing in ColdFusion I keep getting different results.
I wonder if either the vba or ColdFusion methods I'm using are taking the key I'm passing in and transforming it so it no longer matches. I've tried setting keys manually and even generating it with ColdFusion and then setting it in the vba code to match with no luck.
ColdFusion code trying to use RC4:
<cfset test_key = "ZXNlmehY30y3ophXVJ0EJw==">
<cfset encryptedString = Encrypt("CF String",test_key, "RC4")>
<cfoutput>
Encrypted String: #encryptedString#<br />
Encryption Key: #test_key#
</cfoutput>
VBA Code with the same settings: (clsCryptoFilterBox code is here)
NOTE: It appears that this defaults to RC4, which is why I'm using that in ColdFusion above.
Dim encrypted As clsCryptoFilterBox
Set encrypted = New clsCryptoFilterBox
encrypted.Password = "ZXNlmehY30y3ophXVJ0EJw=="
encrypted.InBuffer = "CF String"
encrypted.Encrypt
MsgBox ("Encrypted: " & encrypted.OutBuffer)
EDIT: Ok, more info. I found that ColdFusion needed the key in base64 even though the variable test_key should have worked but apparently the output of a base64 encoded string is not the same as other text encoded into base64.
EDIT 2: I got it working using the Blowfish algorithm found in the file on this website.
Here is my working CF code:
<cfset test_key = toBase64("1234567812345678")>
<cfset encryptedString = Encrypt("CF String", test_key, "RC4", "HEX")>
<cfoutput>
Encrypted String: #encryptedString#<br />
Encryption Key: #test_key#
</cfoutput>
Which outputs:
Encrypted String: F8B519877DC3B7C997
Encryption Key: MTIzNDU2NzgxMjM0NTY3OA==
I had to modify the code in VBA to pad using PKCS7 but once I did that, I was able to verify that it was working correctly. If anyone is interested I could post my changes to the VBA code where I modified the padding as well as added a check on decryption to verify the data via the padding.
I found a decent Blowfish algorithm packaged in the test app found on this download site that actually works with some modifications.
It was using spaces to pad the input text which is not what ColdFusion was doing, so this was making the encrypted string turn out different. The standard encryption that CF does pads with bytes that are all the same and are set to the number of padding bytes being used.
New EncryptString() function:
Public Function EncryptString(ByVal tString As String, Optional ConvertToHEX As Boolean) As String
Dim ReturnString As String, PartialString As String * 8
Dim tPaddingByte As String
Dim tStrLen As Integer
Dim tBlocks As Integer
Dim tBlockPos As Integer
tStrLen = Len(tString)
'Divide the length of the string by the size of each block and round up
tBlocks = (-Int(-tStrLen / 8))
tBlockPos = 1
Do While tString <> ""
'Check that we are not on the last block
If tBlockPos <> tBlocks Then
'Not on the last block so the string should be over 8 bytes, no need to pad
PartialString = Left$(tString, 8)
Else
'Last block, we need to pad
'Check to see if the last block is 8 bytes so we can create a new block
If Len(tString) = 8 Then
'Block is 8 bytes so add an extra block of padding
tString = tString & String(8, Chr(8))
tPaddingByte = " " 'Not really necessary, just keeps the String() function below happy
Else
'Set the value of the padding byte to the number of padding bytes
tPaddingByte = Chr(8 - Len(tString))
End If
PartialString = Left$(tString & String(8, tPaddingByte), 8)
End If
ReturnString = ReturnString & Encrypt(PartialString)
tString = Mid$(tString, 9)
tBlockPos = tBlockPos + 1
Loop
If ConvertToHEX = True Then
EncryptString = ToHEX(ReturnString)
Else
EncryptString = ReturnString
End If
End Function
Since the padding is not just spaces, it needs to be removed on decryption but there is an easy way to do it that also makes this whole process even better. You read the last byte, and then verify the other padding bytes with it.
Public Function DecryptString(ByVal tString As String, Optional ConvertFromHEX As Boolean) As String
Dim ReturnString As String, PartialString As String * 8
Dim tPos As Integer
Dim tPadCount As Integer
If ConvertFromHEX = True Then
tString = HexToString(tString)
End If
Do While tString <> ""
PartialString = Left$(tString, 8)
ReturnString = ReturnString & Decrypt(PartialString)
tString = Mid$(tString, 9)
Loop
'Check the last byte and verify the padding and then remove it
tPadCount = ToHEX(Right(ReturnString, 1))
If tPadCount < 8 Or tPadCount > 1 Then
'Get all the padding bytes and verify them
Dim tPaddingBytes As String
tPaddingBytes = Right(ReturnString, tPadCount)
Dim i As Integer
For i = 1 To tPadCount
If Not tPadCount = Int(ToHEX(Left(tPaddingBytes, 1))) Then
MsgBox "Error while decrypting: Padding byte incorrect (" & tPadCount & ")"
GoTo Done
End If
Next i
ReturnString = Left(ReturnString, Len(ReturnString) - tPadCount)
Else
MsgBox "Error while decrypting: Last byte incorrect (" & tPadCount & ")"
End If
Done:
DecryptString = ReturnString
End Function
I was able to export the class module and can import it into any other possible projects that may need basic encryption. There is a Rijndael class that appears to be working but in a non-standard way as well that I may get around to fixing later, but for now this is what I was looking for.
I'm trying to set up a code in MS Access that increments the last four positions of a text field. The numbers in the text field have seven digits. For example:
0010012
0010013
First three digits represent the manuacturer and the last four the product. These are the ones I want to increment. I am using the code below, which I found online, and it is supposed to be working but I keep getting the error: "Run-time error '13': Type mismatch"
Dim varSifra As Variant
varSifra = DMax("[Sifra]", "tblProducts", "[Manufacturer] = " & Forms!frmProduct!Manufacturer)
Me.[Sifra] = Left(varSifra, 3) & Format(Val(Right(varSifra, 4)) + 1, "0000")
I tried the code without the Format function but instead of incremented number 0010014 I get 00114
Can this help?
Sub Test()
Debug.Print IncrementProduct("0010001") //Prints 0010002
Debug.Print IncrementProduct("0010012") //Prints 0010013
Debug.Print IncrementProduct("0010099") //Prints 0010100
End Sub
Function IncrementProduct(code As String) As String
Dim manufacturerCode As String, padding As String, productCode As String
manufacturerCode = VBA.Left$(code, 3)
productCode = CInt(VBA.Right$(code, Len(code) - Len(manufacturerCode))) + 1
padding = Application.WorksheetFunction.Rept("0", 4 - Len(productCode))
IncrementProduct = manufacturerCode & padding & productCode
End Function
You can use a simple Format call fine, however the input needs to be explicitly converted to a Long first:
Function IncProductNumber(Value)
If IsNull(Value) Then
Let IncProductNumber = Null
Else
Let IncProductNumber = Format(CLng(Value) + 1, "0000000")
End If
End Function
Or, more generically, the desired padding could be inferred from the input:
Function IncTextNumber(Value)
If IsNull(Value) Then
Let IncTextNumber = Null
Else
Let IncTextNumber = Format(CLng(Value) + 1, String$(Len(Value), "0"))
End If
End Function
IncTextNumber("0123") will produce "0124", IncTextNumber("00999") will produce "01000" and so on.
Dim tempManProd As String, tempNumToInc As Integer
tempManProd = 'get the value you are wanting to increment
tempNumToInc = CInt(right(tempManProd, 4))
tempNumToInc = tempNumToInc + 1
'This will make sure that the 0s get added back to the front of the product
Do While (Len(tempManProd & "") + Len(tempNumToInc & "")) < 7
tempManProd = tempManProd & "0"
Loop
tempManProd = tempManProd & CStr(tempNumToInc)
I'm looking to find a way to remove stop words using a function in Visual Basic inside my Access DB.
Today I'm just doing several replace but I know it's not the right way as I wouldn't know if I'm removing the Stop Word as a word or within a word.
Any help would be great, I just cannot find any way to do this on VB.
Okay, you mean something like this, right?
OutputString = Replace("They answered the question", "the", "")
This replaces all occurrences of "the" from the phrase, including part of the word "They".
The simplest solution would be to put spaces before and after the word to replace:
OutputString = Replace("They answered the question", " the ", "")
This works for the phrase in my above example, but it won't work when the word occurs at the beginning or at the end of the phrase.
For these cases, you need to do more. Something like this:
Public Function RemoveStopWords( _
ByVal Phrase As String, _
ByVal WordToRemove As String _
) As String
Dim RetVal As String
Dim Tmp As String
'remove the word in the middle of the phrase
RetVal = Replace(Phrase, " " & WordToRemove & " ", " ")
'remove the word at the beginning
Tmp = WordToRemove & " "
If Left(RetVal, Len(Tmp)) = Tmp Then
RetVal = Mid(RetVal, Len(Tmp) + 1)
End If
'remove the word at the end
Tmp = " " & WordToRemove
If Right(RetVal, Len(Tmp)) = Tmp Then
RetVal = Left(RetVal, Len(RetVal) - Len(Tmp))
End If
RemoveStopWords = RetVal
End Function
This works as long as the words in the phrase are always separated with blanks.
When there can be other separators than blanks, you have to do even more.
For example, instead of hardcoding the blanks in the function, you could loop over a list of separators and execute the function for each one.
I won't show this as code now, but you get the idea.