PDA

View Full Version : drag & drop merge with copy-paste-code



Phil1344
11-16-2018, 02:09 AM
Hi everyone,

I have two codes as follows.

Number 1: gives me a drag&drop window for files and Drops thefile path into my Excel file. This works via userform.


Option Explicit
Const vbDropEffectNone = 0
Const vbDropEffectCopy = 1
Const vbDropEffectMove = 2

Const vbCFFiles = 15
Private Sub bAbbrechen_Click()
Unload Me
End Sub
Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject,Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim i As Long
If Data.GetFormat(vbCFFiles) Then
s = ActiveCell.Column
z = Cells(ActiveSheet.Rows.Count,s).End(xlUp).Row
If Not (IsEmpty(Cells(z, s))) Then z = z +1
For i = 1 To Data.Files.Count
ActiveSheet.Cells(z,s).Hyperlinks.Add ActiveSheet.Cells(z, s), Data.Files(1)
z = z + 1
Next
End If
End Sub
Private Sub ListView1_OLEDragOver(Data As MSComctlLib.DataObject,Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single,State As Integer)
Effect = vbDropEffectCopy
End Sub

Private Sub UserForm_Click()
End Sub

Number 2: retrieves cell values from specified files and copies theminto defined cell areas in my file. As of now, it finds those files via theThisWorkbook.Path command, but I need it to get the files from the path comingfrom my drag&drop window.


Sub prcX()
Dim strDatei As String
Dim lngSpalte As Long
Dim lngC As Long
Dim vntQuelle As Variant
Dim vntZiel As Variant
Dim vntVersatz As Variant

'On Error Resume Next
'Eintrag in Spalte E
vntQuelle = Array("E19:E74", "G8","G9", "G10")
vntZiel = Array(5, 3, 2, 1)
vntVersatz = Array(-1, -1, 1, -1)
lngSpalte = 4

strDatei =ActiveWorkbook.Worksheets("Tabelle1").Range("A61:A71").Value
Do While strDatei <> ""
For lngC = o To UBound(vntQuelle)
IfGetDataClosedWB(ThisWorkbook.Path & "\PBDs\", _
strDatei,"Tabelle1", CStr(vntQuelle(lngC)), _
ThisWorkbook.Worksheets(1).Cells(vntZiel(lngC), lngSpalte).Offset(,vntVersatz(lngC))) Then
If lngC =UBound(vntQuelle) Then lngSpalte = lngSpalte + 4
End If
Next lngC
strDatei = Dir()
Loop
End Sub

Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, _
sourceSheet As String, _
SourceRange As String, _
TargetRange As Range) AsBoolean

Dim strQuelle As String
Dim Zeilen As Long
Dim Spalten As Long 'Bytehabe ich in Long geändert
On Error GoTo InvalidInput
strQuelle = "'" & SourcePath &"[" & SourceFile & "]" & _
sourceSheet & "'!" & _
Range(SourceRange).Cells(1, 1).Address(0, 0)
Zeilen = Range(SourceRange).Rows.Count
Spalten = Range(SourceRange).Columns.Count
With TargetRange.Cells(1, 1).Resize(Zeilen,Spalten)
.Formula = "=IF(" &strQuelle & "="""","""","& strQuelle & ")"
.Value = .Value
End With
GetDataClosedWB = True
Exit Function

InvalidInput:
MsgBox "Die Quelldatei oder der Quellbereichist ungültig!", _
vbExclamation, "Getdata from closed Workbook"
GetDataClosedWB = False
End Function


So, Questions would be: How can I specify the cell area where Iwould want the paths from the drap&drop to be displayed? And then, how canI tell the macro to take the path from the given cell instead from the sharedrive path?

Can anybody provide some help here? I got those codes from the netand other forums, since I cannot code them myself. Therefore sorry, if somecommands are German, pls let me know if you need them translated.

Thanks!!
Phil