< návrat zpět
MS Excel
Téma: Kopírování s libovolnou příponou ![rss](./plugins/templates/wall_2C/images/icons/rss.png)
Zaslal/a Lugr 1.3.2022 18:17
Ahoj,
mám dotaz, pro kopírování z ext. souboru používám tento kód od "elninoslov". Problém je když se změní přípona. Jak mám zakomponovat, aby vyzkoušel všechny tři přípony?
Děkuji.
Sub Import()
Dim Cesta As String
Dim Nazev As String
Dim Soubor As String
Dim Zdroj As String
Cesta = "C:\Plocha\"
Nazev = "ZDROJ" (*.xls, * .xlsx, * .xlsm)
Soubor = Cesta & Nazev
If Dir(Soubor) = "" Then MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical: Exit Sub
Zdroj = "'" & Cesta & "[" & Nazev & "]" & "List1" & "'!"
With Sheets("List1").Range("B2")
.Formula = "=IF(" & Zdroj & "B2" & "="""",""""," & Zdroj & "B2" & ")"
.Value = .Value
End With
End Sub
Anonym(1.3.2022 20:15)#052206 ![avatar](./pictures/avatars/no-avatar.jpg)
Nazev= "ZDROJ" (*.xls*)
citovat
r13(1.3.2022 20:31)#052207 ![avatar](./pictures/avatars/no-avatar.jpg)
Nápoveda:
If Len(Dir(Soubor & ".xls")) = 0 And Len(Dir(Soubor & ".xlsx")) = 0 And Len(Dir(Soubor & ".xlsm")) = 0 Then
MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical
Exit Sub
Else: MsgBox "Soubor " & Soubor & " existuje!"
End Ifcitovat
Lugr(1.3.2022 20:57)#052208 ![Lugr](./pictures/avatars/5ea444280f10d.jpg)
r13 napsal/a:
Nápoveda:
If Len(Dir(Soubor & ".xls")) = 0 And Len(Dir(Soubor & ".xlsx")) = 0 And Len(Dir(Soubor & ".xlsm")) = 0 Then
MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical
Exit Sub
Else: MsgBox "Soubor " & Soubor & " existuje!"
End If
Děkuju, ale tohle řeší ale pouze kontrolu existence souboru nikoliv samotný import (vzorec)
citovat
r13(2.3.2022 6:35)#052210 ![avatar](./pictures/avatars/no-avatar.jpg)
Iste... Myslel som, že zvyšok si už budeš vedieť, na základe nápovedy, upraviť.
OK... Zvyšok Tvojho pôvodne uvedeného kódu funguje správne?
citovat
r13(2.3.2022 7:59)#052211 ![avatar](./pictures/avatars/no-avatar.jpg)
Sub Import()
Dim Cesta As String
Dim Nazev As String
Dim Soubor As String
Dim Zdroj As String
Dim Pripona As String
Cesta = "C:\Plocha\"
Nazev = "ZDROJ"
Soubor = Cesta & Nazev
If Len(Dir(Soubor & ".xls")) = 0 And Len(Dir(Soubor & ".xlsx")) = 0 And Len(Dir(Soubor & ".xlsm")) = 0 Then
MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical
Exit Sub
Else
If Len(Dir(Soubor & ".xls")) <> 0 Then Pripona = "xls"
If Len(Dir(Soubor & ".xlsx")) <> 0 Then Pripona = "xlsx"
If Len(Dir(Soubor & ".xlsm")) <> 0 Then Pripona = "xlsm"
End If
Zdroj = "'" & Cesta & "[" & Nazev & "." & Pripona & "]" & "List1" & "'!"
With Sheets("List1").Range("B2")
.Formula = "=IF(" & Zdroj & "B2" & "="""",""""," & Zdroj & "B2" & ")"
.Value = .Value
End With
End Subcitovat
Lugr(2.3.2022 8:17)#052212 ![Lugr](./pictures/avatars/5ea444280f10d.jpg)
Teď si tady nad tím lámu hlavu.
Děkuji funguje super.
citovat