Prestalo mi to fungovat pri zmene exelu na verzi 2016

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Uživatelský avatar
Snekment
nováček
Příspěvky: 35
Registrován: srpen 12
Pohlaví: Muž
Stav:
Offline

Prestalo mi to fungovat pri zmene exelu na verzi 2016

Příspěvekod Snekment » 15 čer 2018 15:44

Sub Import_2()
Dim MsgResponse, MsgTit As String
Dim ImportFirstFile As Boolean, ImportDir As String, ImportFile As String
Dim ZdrojSoubor As Workbook, ZdrojList As Worksheet, ListData As String, ZdrojAdresa As String
Dim ZdrojOblast As Range, c As Range
Dim CilOblast As Range, i As Integer, j As Integer
MsgTit = "Import dat"
ImportFirstFile = True ' identifikace prvniho souboru v adresari
ImportDir = "\\192.168.2.244\zlutysanon_vaclavak\Zaměstnanci - seznam" ' cesta k souborum
ZdrojAdresa = "A5,c13,d15,a17,a19,a21,a23,a25,a27,a33,a35,a39,a41" ' adresy bunek se zdrojovymi daty
Set CilOblast = ActiveWorkbook.Worksheets("seznam").Range("a2")
Application.ScreenUpdating = False
j = 0 ' ofset radku na cilovem listu
Do
If ImportFirstFile Then
ImportFile = Dir(ImportDir & "\*.xlsm") ' prvni soubor v adresari
If ImportFile = "" Then _
MsgResponse = MsgBox("Adresář souboru: '" & ImportDir _
& "' k importu je prázdný!", _
vbOKOnly + vbInformation, MsgTit): Exit Do
ImportFirstFile = False
Else
ImportFile = Dir ' dalsi soubory v adresari
End If
If ImportFile = "" Then _
MsgResponse = MsgBox("V adresáři souboru: '" & ImportDir _
& "' k importu nejsou další soubory!", _
vbOKOnly + vbInformation, MsgTit): Exit Do
'
'
ListData = "Zakladaci karta" ' algoritmus prirazeni nazvu zdrojoveho listu dle souboru???
'
Set ZdrojSoubor = Workbooks.Open(ImportDir & "\" & ImportFile) ' otevrit soubor
Set ZdrojList = ZdrojSoubor.Worksheets(ListData)
Set ZdrojOblast = ZdrojList.Range(ZdrojAdresa)
i = 0 ' ofset sloupcu na cilovem listu
For Each c In ZdrojOblast.Cells
CilOblast.Offset(j, i).Value = c.Value
i = i + 1 ' dalsi sloupec na cilovem listu
Next c
ZdrojSoubor.Close True
j = j + 1 ' dalsi radek na cilovem listu
Loop ' dalsi soubor
Range("A1:m85").Select
ActiveWorkbook.Worksheets("seznam").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("seznam").Sort.SortFields.Add Key:=Range("A2:A85") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("seznam").Sort
.SetRange Range("A1:m85")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub

Prosím tohle se mi ukazuje a ja nevim proc to najednou nefunguje poradite nekdo ?

Dekuji Kment

Reklama
Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

Re: Prestalo mi to fungovat pri zmene exelu na verzi 2016

Příspěvekod elninoslov » 16 čer 2018 12:58

IP platná ?
Cesta platná ?
Win ste nemenil ?
Účet z ktorého sa pripájate má povolený prístup do zložky ? (mohli ste sa prelogovať na iné konto, zmeniť konto, na servery mohol byť zásah,...)
Ak dáte cestu na skúšku na lokálnom PC, ide to OK ?
Ak dáte cestu na skúšku na iné sieťové miesto (iný PC), ide to ?


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Přestalo fungovat kliknutí na touchpadu (L+R)
    od Micmen » 21 led 2024 20:58 » v Problémy s hardwarem
    0
    472
    od Micmen Zobrazit poslední příspěvek
    21 led 2024 20:58
  • Aktivace Windows po změně disku Příloha(y)
    od JanC » 15 říj 2023 20:32 » v Windows 11, 10, 8...
    24
    3984
    od JanC Zobrazit poslední příspěvek
    08 lis 2023 08:19
  • Problém s připojením na wifi síť při změně PC Příloha(y)
    od Baader » 09 srp 2023 10:38 » v Sítě - hardware
    18
    3028
    od Baader Zobrazit poslední příspěvek
    10 srp 2023 14:16
  • PowerPoint osekává zvuk při změně snímku
    od Venus » 12 úno 2024 16:35 » v Kancelářské balíky
    2
    1124
    od Venus Zobrazit poslední příspěvek
    13 úno 2024 16:57
  • Přestal mi fungovat mikrofon s kamerou
    od Minapark » 23 úno 2024 19:07 » v Problémy s hardwarem
    4
    586
    od Minapark Zobrazit poslední příspěvek
    28 úno 2024 20:30

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti