Sad Der
accessd666 at yahoo.com
Tue Aug 12 00:45:32 CDT 2003
Here you go. Just paste the stuff in you're code and voila. Select a couple of things in Excel (or Word or Internet or whatever) and paste it. And no, I did not yet add error handling! The only thing you have to figure out is the object I use to plant the clipboard data in :-) Private Const CF_TEXT = 1 Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Long, ByVal ByteLen As Long) Private Sub Paste_Click() Dim hStrPtr As Long Dim lLength As Long Dim sBuffer As String Dim strValues As String Dim tmp_array Dim i As Integer '------------------------------------------------------------------------- OpenClipboard Me.hwnd hStrPtr = GetClipboardData(CF_TEXT) If hStrPtr <> 0 Then lLength = lstrlen(hStrPtr) If lLength > 0 Then sBuffer = Space$(lLength) CopyMemory ByVal sBuffer, ByVal hStrPtr, lLength strValues = StringWithoutEnters(sBuffer) End If End If CloseClipboard 'Add values to listbox lstEANCopy.RowSource = strValues End Sub '========================================================================================= ' Function Name : StringWithoutEnters ' Parameters : No parameters ' Return value : (Long) <MEANING> ' Purpose : <PURPOSE> ' Assumptions : --- ' Uses : --- ' Created : 2003-Jul-24 10:09, MaRo ' Modifications : '========================================================================================= Public Function StringWithoutEnters(ByVal r_strWithEnters As String) As String On Error GoTo ErrorHandler r_strWithEnters = Replace(Replace(Replace(r_strWithEnters, vbCrLf, ";"), vbCr, ";"), vbLf, ";") StringWithoutEnters = r_strWithEnters Exit Function ErrorHandler: 'r_strError = Err.Source & " (" & Err.Number & ") " & Err.Description End Function Function GetNumberOfMarkers(strSearch As String) As Integer Dim lngLength As Long Dim intPos As Integer Dim i As Integer Dim intMarkerPos As Integer Dim intOccurencesFound As Integer i = 1 intOccurencesFound = 0 'Get the length of the string lngLength = Len(strSearch) intPos = 1 'Loop through the string Do While i <= lngLength 'find the first marker (#) intMarkerPos = InStr(intPos, strSearch, "#", vbTextCompare) intPos = intMarkerPos + 1 i = intPos intOccurencesFound = intOccurencesFound + 1 Loop GetNumberOfMarkers = intOccurencesFound End Function --- Brindza Ervin <viner at EUnet.yu> wrote: > Sander > Can yuo send me your solution, it would be > interested for me too! > Many TIA, > Ervin > > > __________________________________ Do you Yahoo!? Yahoo! SiteBuilder - Free, easy-to-use web site design software http://sitebuilder.yahoo.com