Folge dem Video um zu sehen, wie unsere Website als Web-App auf dem Startbildschirm installiert werden kann.
Anmerkung: Diese Funktion ist in einigen Browsern möglicherweise nicht verfügbar.
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