[AccessD] Re: Copy range of ID's from excel <SOLVED + CODE>

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


More information about the AccessD mailing list