zmen v kodu:
misto
objOpen.AllowMultiSelect = False
napis
objOpen.AllowMultiSelect = True
Milancitovat
misto
objOpen.AllowMultiSelect = False
napis
objOpen.AllowMultiSelect = True
Milancitovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Upravení makra spojení
Uzamčeno - nelze přidávat nové příspěvky.
MS Excel
Téma: Upravení makra spojení 
Zaslal/a agnusxx 1.10.2012 16:50
Dobrý den, hodně jsem hledal makro na spojení X sešitů do jednoho našel jsem hodně ruzných druhů, ale vetšinou mi to nevyhovuje, ať už že to nefunguje na 100% nebo to není ono.
Našel jsem jedno které mi vyhovuju, respektive by mi vyhovovalo ale potřeboval bych jej upravit. Puvodně dělá že otevře okno ve kterém otevřete soubor který chccete spojit do sešitu ve kterém je to makro, Já bych potřeboval aby šel provést hromadný výběr. Tzn, otevře se mi to okynko a pujde v něm označit více souboru naráz které chci k sešitu připojit. Již samotné připojení v makru je to funguje perfektně jde mi jen o ten výběr více sešitů.
Chtěl bych poprosit pokud by někdo z vás věděl jak to upravit byl bych mu moc vděčný
Zde soubor s makrem: www.propetra.tym.cz/www/A.xls
(makro se spouští alt+F8 sheet imports)
Uzamčeno - nelze přidávat nové příspěvky.(2.10.2012 10:09)#009680
(2.10.2012 10:57)#009681
Aha, tak jenom toto nestaci. To makro jsem upravil:
Sub Test()
Dim wb As Workbook, wbX As Workbook
Dim i As Integer, j As Integer
'zkratka pro tento sesit
Set wb = ThisWorkbook
' Otevri dialog
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = ""
.AllowMultiSelect = True
.Filters.Add "Excel", "*.xls"
.Show
' pro kazdy soubor
For i = 1 To .SelectedItems.Count
Workbooks.Open .SelectedItems(i)
Set wbX = ActiveWorkbook
'nakopiruj listy do wb
For j = 1 To wbX.Sheets.Count
wbX.Sheets(j).Copy after:=wb.Sheets(wb.Sheets.Count)
Next j
Next i
End With
End Subcitovat
Sub Test()
Dim wb As Workbook, wbX As Workbook
Dim i As Integer, j As Integer
'zkratka pro tento sesit
Set wb = ThisWorkbook
' Otevri dialog
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = ""
.AllowMultiSelect = True
.Filters.Add "Excel", "*.xls"
.Show
' pro kazdy soubor
For i = 1 To .SelectedItems.Count
Workbooks.Open .SelectedItems(i)
Set wbX = ActiveWorkbook
'nakopiruj listy do wb
For j = 1 To wbX.Sheets.Count
wbX.Sheets(j).Copy after:=wb.Sheets(wb.Sheets.Count)
Next j
Next i
End With
End Subcitovat
To vaše makro je skvělé lepší než to puvodní co tam je, ale ma to jednu chybu, ono to za seboz nezavírá ty sešity co to otvírá, tzn když otevřu 20 sešitu tak mi to načítá ale na konci mi zustane otevřenych 20 oken na liště, potřeboval bych aby to po sobě pozavíralo, vždy jen otevřelo načetlo a zavřelo. Tak jak je to v tom puvodním makru, ale bohužel se mi nedaří to dostat do toho vašeho pokud by jste to mohl upravit byl bych vam moc vděčný.citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články