po delší době jsem opět začal něco tvořit ve VBA a čím víc toho vím, tím víc se mi zdá, že mi chybí úplné základy...
Teď momentálně řeším v čem jsou rozdílné ovládací prvky. Mám na mysli: Ovládací prvky formuláře a Ovládací prvky ActiveX. Popřípadě ještě proč nevyužít UserForm přímo ve VBA?
Další (navazující) problém je, že vlastně nevím jak s takovým listboxem (activeX) pracovat, páč jsem přišel na to, že pokud je v sheetu 1 tak se na něj nemůžu odkazovat z Modulu.
Tady je kód co mám v Sheetu1 (kde mám Listbox ActiveX)
Kód: Vybrat vše
Sub Folder_Selection()
Dim folder As FileDialog
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
folder.Title = "Select a Folder"
folder.AllowMultiSelect = False
folder.Show
ChDir (folder.SelectedItems(1))
Allfiles = Dir("*.*")
ListBox1.Clear
Do While Allfiles <> ""
ListBox1.AddItem Allfiles
Allfiles = Dir
Loop
Set folder = Nothing
End Suba poté tam mám tento kód:
Kód: Vybrat vše
ub Merge()
Dim x As Long, wb As Workbook
Dim i As Long
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
msg = msg & .List(i) & vbNewLine
End If
Next
End With
If msg = vbNullString Then
MsgBox "Nothing was selected! Please make a selection!"
Exit Sub
Else
Check = MsgBox("You selected:" & vbNewLine & msg & vbNewLine & _
"Do you really want merge these files?", _
vbYesNo + vbInformation, "Please confirm")
End If
If Check = vbYes Then
With ListBox1
Application.DisplayAlerts = False
For x = 0 To .ListCount - 1
If .Selected(x) = True Then
Set wb = Workbooks.Open(FilePath & .List(x), UpdateLinks:=3)
Call Merge2
End If
Next x
End With
Else
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next
End If
End SubJak si můžete všimnout mám tam volání na funkci Merge2, protože mi z nějákého důvodu nefungovala přímo v těle této funkce.
Ten Call Merge2 odkazuje na Module1 kde je tento kód:
Kód: Vybrat vše
Sub Merge2()
Dim wsSheet As Worksheet
On Error Resume Next
Set wsSheet = Sheets("Cleansed Output review")
On Error GoTo 0
If Not wsSheet Is Nothing Then
Sheets("Cleansed Output review").Select
With Range("A1:BZ20")
Set Foundcell = .Cells.Find(what:="CCOMP", _
after:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
Lookat:=xlPart, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
End With
If Foundcell Is Nothing Then
MsgBox "Not found and there should be a ..."
Exit Sub
Tady nastává problém, protože místo msgboxu bych chtěl vypsat do nového listboxu jméno toho souboru, ve kterém není to hledané slovo. Jenže jak, když se tu nemůžu odkazovat na práci s listboxem, jinak dostávám chybu Object not defined....
Kód: Vybrat vše
Else
Foundcell.Offset(1, 0).Activate
Range(Selection, Foundcell.End(xlToRight).Offset(1, 0)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWorkbook.Close False
Workbooks("Merging template.xlsm").Activate
Sheets("Final").Select
Range("A5").Select
If Range("A5") = Empty Then
ActiveSheet.Paste
Else
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Range("A" & LastRow + 1).Select
End With
ActiveSheet.Paste
End If
End If
Else
Msgbox "Whatever..."
End If
End Sub
Jestli je to zmateny tak se omlouvám, ale snažil jsem se
A taky předem díky za rady!
David