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