Follow along with the video below to see how to install our site as a web app on your home screen.
Anmerkung: This feature currently requires accessing the site using the built-in Safari browser.
Option Explicit
Public lLRowS As Long
Public lLRowD As Long
Public sColS As String
Public sColD As String
Public iShNumS As Integer
Public iNum As Integer
Public vFile As Variant
Public sFolder As String
Public sConfig As String
Sub CopySource()
Dim MsgVal As Byte
Dim i As Integer
MsgVal = MsgBox("", 4, "Work with Ini-File?")
If MsgVal = 7 Then
iNum = Application.Inputbox(Prompt:="", Title:="Number of Files?", Type:=1)
Inputbox
ElseIf MsgVal = 6 Then
ReadIni
End If
For i = 1 To iNum
lLRowD = Cells(Rows.Count, sColD).End(xlUp).Row
vFile = Application.GetOpenFilename("Excelfiles(*.xlsx), *.xlsx", , "Open a Excelfile")
If vFile = False Then Exit Sub
Workbooks.Open (vFile)
With Worksheets(iShNumS)
lLRowS = .Cells(Rows.Count, sColS).End(xlUp).Row
.Range(sColS & "2:" & sColS & lLRowS).Copy ThisWorkbook.ActiveSheet.Range(sColD & lLRowD + 1)
ActiveWorkbook.Close False
End With
If i <> iNum And MsgVal = 7 Then Inputbox
Next i
End Sub
Sub Inputbox()
iShNumS = Application.Inputbox(Prompt:="", Title:="Sheetnumber Source?", Type:=1)
sColS = Application.Inputbox(Prompt:="", Title:="Column Source?", Type:=2)
sColD = Application.Inputbox(Prompt:="", Title:="Column Destination?", Type:=2)
End Sub
Sub ReadIni()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Folder?"
.ButtonName = "Choose..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
sFolder = .SelectedItems(1)
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
Else
If sFolder = "" Then Exit Sub
End If
End With
sConfig = sFolder & "config.ini"
If Dir$(sConfig, 0) <> "" Then
iNum = CInt(GetIniString(sConfig, "NumFiles", "numf", 0))
iShNumS = CInt(GetIniString(sConfig, "NumSheet", "shnum", 0))
sColS = GetIniString(sConfig, "ColSource", "cols", "")
sColD = GetIniString(sConfig, "ColDest", "cold", "")
End If
End Sub
Option Explicit
Declare Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpString As Any, _
ByVal lplFileName As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Public Function GetIniString( _
ByVal INIFile As String, _
ByVal Section As String, _
ByVal Titel As String, _
ByVal Propty As String, _
Optional ByVal nSize As Integer = 256) As String
Dim lResult As Long
Dim sValue As String
sValue = Space$(nSize)
lResult = GetPrivateProfileString(Section, Titel, _
"Fail", sValue, Len(sValue), INIFile)
GetIniString = Left$(sValue, lResult)
End Function