< návrat zpět

MS Excel


Téma: zistenie nazvu druheho otvoreneho suboru rss

Zaslal/a 25.10.2017 8:40

ahojte
mam subor s makrom do ktoreho bude makro natahovat data z dalsieho suboru. Ten zdroj dat bude mat zakazdym ine meno a preto to chcem vyriesit tak ze uzivatel otvori v exceli iba tieto dva subory a spusti makro (tlacitkom v subore s makrom). Ako najjednoduhsie makrom zistim nazov toho druheho (zdrojoveho) suboru aby som ho mohol v makre pouzit?
dakujem

Zaslat odpověď >

#038130
Jeza.m
Sice by bylo rozumnější aby uživatel v souboru s makrem stiskl tlačítko a zobrazil se mu dialog pro výběr souboru, ale abych odpověděl na zadání, tak viz. kód níže. Blbý bude až budeme mít otevřeno více souborů :-), nebo když se mu podaří každý soubor spustit v jiné instanci excelu - proto bych doporučil to přehodnotit a mrknout i na druhý příklad.

Dim jmeno As String
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then
jmeno = wb.Name
Exit For
End If

Next

If jmeno <> "" Then MsgBox jmeno Else MsgBox "Nenalezeno"


Výběr souboru ...
Dim soubor As String
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
Application.FileDialog(msoFileDialogOpen).Show
If Application.FileDialog(msoFileDialogOpen).SelectedItems.Count = 1 Then
soubor = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
MsgBox soubor
End If
citovat
#038131
elninoslov
Rozhodne 2. možnosť. Inak by to bolo veľké riziko. Nezabudnite, že operácie makrom nemajú Undo. Čo ak poseriete iný súbor ? Určite Open dialog.citovat
#038132
avatar
Já tohle používám jako zodpovědný uživatel a hlavně sám pro sebe v následující podobě - je to podobné jako od Jeza.m - ale s potvrzením souboru, o který se jedná:
Sub overit_soubor()
Cislo_Wbook = -1
For i = 1 To Workbooks.Count
If Workbooks(i).Name <> ThisWorkbook.Name Then
Dotaz = MsgBox("Doplnit data z otevřeného souboru" _
& vbNewLine & Workbooks(i).Name & " ?", vbYesNo, _
"Výběr souboru")
Select Case Dotaz
Case vbNo
GoTo NE_Dalsi_soubor
Case vbYes
Cislo_Wbook = i
Exit For
End Select
End If
NE_Dalsi_soubor:
Next i
' --------
If Cislo_Wbook < 0 Then
MsgBox "Soubor není určen, musí být otevřený!"
Exit Sub
End If
' zde po vyberu souboru dalsi cinnost, zde jen msgbox
Cesta_B = Workbooks(Cislo_Wbook).Path & "\" & Workbooks(Cislo_Wbook).Name
Jmeno_B = Workbooks(Cislo_Wbook).Name
MsgBox "pracuju se souborem " & Cesta_B
End Sub
citovat
#038133
avatar
ahojte
dakujem za odpovede
samozrejme pouzivam moznost vyberu tam kde je to nutne, taktiez kontrolujem pocet a spravnost otvorenych suborov tam kde je to potrebne. toto mam vsak specificky pripad kde sa kazdy tyzden meni nazov suboru a obsah ostava. Urcite si nieco vyberiem z toho co ste mi tu ponukli
co sa tyka UNDO, viem, dolezite subory si moji uzivatelia kopiruju k sebe (vecsina len na plochu 5 ), takze orginal dolezity subor ostava na sieti a nic sa mu nestane.
este raz Vďaka.citovat
#038139
avatar
1)No to jméno Sešitu se mění podle nějakého vzoru, ne?
Pak by kód mohl vědět jaký soubor hledá. Ne?
2)"Obsah zůstává stejný". Testovat nějakou buňku/buňky pro identifikaci.citovat
#038140
avatar
Ano. Nazov suboru sa meni logicky (meni sa KWxx) avsak uzivatel je tvorivy a je schopny tam dat niekedy male pismena, niekedy medzeru (uz sa stalo). - nebudem vymyslat zlozity kod na kontrolu blbosti uzivatela , hlavne ked je to mimo moje pracovne zaradenie a v podstate zadarmo.
Kontrola obsahu bunky, ano , to som uz parkrat pouzil, asi to hodim aj sem.
Dakujem.citovat
#038141
avatar
Ja na vybratie iba VOPRED URČENÝCH SÚBOROV používam toto makro

Sub nechaTIbaUrcene()

Dim Wbk As Workbook, Arr
Arr = Array("Toto1.xls", "Toto2.xls", "Toto3.xls", ThisWorkbook.Name)
For Each Wbk In Workbooks
If IsError(Application.Match(Wbk.Name, Arr, 0)) Then Wbk.Close
Next Wbk
End Sub

Mám istotou, že sa neprimieša nič a mená súborov sú presné. V zobrazenom makre ostanú tri súbory a aktuálny súbor.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

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.

On-line nástroje