úprava makra Vyřešeno

[ondaqo]

Zdravím páni,

chcel by som vás poprosiť o pomoc/radu.

Mám makro ktoré vkladá 10 riadkov 10 stĺpcov z iného uzavretého súboru.
Problém mám šak vtedy, ak sa daný súbor uloží do iného adresára, keďže každý deň sa robí nový zoznam. Ak sa vrátim k staršiemu už mi vypíše len "Soubor nenalezen".

Je možné upraviť daný kód, tak aby ak je súbor uložený v inom adresári ako je zapísané v kóde, nejakým spôsobom ukázal cestu k danému súboru, prípadne vyzval aby som mohol cestu zmeniť napr cez Msgbox.

ďakujem veľmi za pomoc...

Kód:

Private Function PrevzitHodnotu(cesta, soubor, list, odkaz)
' Načte hodnotu z uzavřeného sešitu
Dim arg As String

' Zkontrolujeme, zda soubor existuje
If Right(cesta, 1) <> "\" Then cesta = cesta & "\"
If Dir(cesta & soubor) = "" Then
PrevzitHodnotu = "Soubor nenalezen"
Exit Function
End If

' Vytvoříme parametr
arg = "'" & cesta & "[" & soubor & "]" & list & "'!" & _
Range(odkaz).Range("A1").Address(, , xlR1C1)

' Spustíme makro XLM
PrevzitHodnotu = ExecuteExcel4Macro(arg)
End Function



Sub TestPrevzitHodnotu2()
Dim p As String, f As String
Dim s As String, a As String
Dim r As Long, c As Long
p = "C:\Users\ondaqo\Desktop\vzor_3_5"
f = "Zoznam.xls"
s = "Zoznam"
Application.ScreenUpdating = False
For r = 1 To 10
For c = 1 To 10
a = Cells(r, c).Address
Cells(r, c) = PrevzitHodnotu(p, f, s, a)
Next c
Next r
End Sub

[Reklama]

[cmuch]

Pokus, moje verze fce.

Kód: Vybrat vše

Private Function PrevzitHodnotu(cesta, soubor, list, odkaz)
  ' Načte hodnotu z uzavřeného sešitu
  Dim arg As String

  ' Zkontrolujeme, zda soubor existuje
  If Right(cesta, 1) <> "\" Then cesta = cesta & "\"
    If Dir(cesta & soubor) = "" Then
      PrevzitHodnotu = Application.GetOpenFilename()
      ' Pokud nic nevybrano tak konec
      If PrevzitHodnotu = "False" Then
        PrevzitHodnotu = "Soubor nevybrán"
        Exit Function
        End If
    End If
  End If

' Vytvoříme parametr
arg = "'" & cesta & "[" & soubor & "]" & list & "'!" & _
Range(odkaz).Range("A1").Address(, , xlR1C1)

' Spustíme makro XLM
PrevzitHodnotu = ExecuteExcel4Macro(arg)
End Function


[ondaqo]

Hmm ešte možno jedna vec...

to upravené predchádzajúce makro mi po zadaní cesty k potrebnému súboru vyhodí chybné hlásenie na reštartovanie excelu.


Je možné aby systém zistil cestu kde je tento súbor uložený? a táto adresárovú štruktúra by sa potom v rámci kódu menila, podľa toho kde sa bude súbor v budúcnosti ukladať.

Príklad teraz mám súbor uložený na ploche C:\Users\ondaqo\Desktop\PC-Help, ďalší týždeň bude v D:\PC-Help\10 a túto cestu potrebujem aby sa mi automaticky menila.

Daný parameter by sa mal zobraziť (označené červenou):


Private Function PrevzitHodnotu(cesta, soubor, list, odkaz)
' Načte hodnotu z uzavřeného sešitu
Dim arg As String

' Zkontrolujeme, zda soubor existuje

If Right(cesta, 1) <> "\" Then cesta = cesta & "\"
If Dir(cesta & soubor) = "" Then
PrevzitHodnotu = "Soubor nenalezen"
Exit Function
End If

' Vytvoříme parametr
arg = "'" & cesta & "[" & soubor & "]" & list & "'!" & _
Range(odkaz).Range("A1").Address(, , xlR1C1)

' Spustíme makro XLM
PrevzitHodnotu = ExecuteExcel4Macro(arg)
End Function



Sub TestPrevzitHodnotu2()
Dim p As String, f As String
Dim s As String, a As String
Dim r As Long, c As Long
p = "C:\Users\ondaqo\Desktop\vzor_3_5"
f = "Zoznam.xls"
s = "Zoznam"
Application.ScreenUpdating = False
For r = 1 To 10
For c = 1 To 10
a = Cells(r, c).Address
Cells(r, c) = PrevzitHodnotu(p, f, s, a)
Next c
Next r
End Sub






.... ďakujem

[cmuch]

Jestli to dobře chápu tak budeš nejprve muset ten soubor vyhledat a pak do makra doplnit novou cestu,
třeba jako tady viewtopic.php?f=35&t=105509
Proč se musí měnit pořád cesta?

[ondaqo]

skor som myslel ci nie je nejake makro ktore vie rozoznat umiestnenie suboru a automaticky ho menit v zapise

subor sa meni preto lebo ho treba archivovat a dorobil som tam aktualizacne tlacitko a ak sa dany subor ulozi na ine miesto a aktualizuje subor tak potom s a sucasne hodnoty ulozene v subore sa prepisu co nechcem

[cmuch]

Pokud se jedná o vyhledání aktuálně otevřeného souboru tak použij ThisWorkbook.Path

[ondaqo]

No vložil som tento zápis do kódu a vidím že je zatiaľ to funguje. :)

ďakujem veľmi pekne