Povoleni úprav siťového souboru

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

Moderátor: Mods_senior

luko02420
Level 1.5
Level 1.5
Příspěvky: 140
Registrován: únor 12
Pohlaví: Nespecifikováno

Povoleni úprav siťového souboru

Příspěvekod luko02420 » 20 bře 2019 13:24

Dobrý den, potrebuji poradit jak pomoci vba povolit upravy sitoveho souboru, ke kterému pristupuji dva PC.
Poskládal jsem si makro ktere funguje ale jenom na jednom PC. Na druhem ne a ne to rozchodit. Sesit se otevre a nepovoli se upravy.
Jenom se omlouvam za ten kod nejak jsem to slatal dohromady ale funguje mi to.
Děkuji vsem za pomoc.

Moc se omlouvám za založení noveho vlakna, uz me to funguje. Pouzivam volani maker a priradil jsem spatne makro.
Jeste jednou se omlouvam.

Kód: Vybrat vše

Sub lk()

Application.ScreenUpdating = False

'umístění zdroje (cesta)
ChDir "Z:\Ceník\"
'otevření zdrojového souboru
Workbooks.Open Filename:="Z:\Ceník\ ceník .xlsm"
'název listu
Sheets("Ceník lak").Select
'oblast kopírování ve zdroji
Range("A2:V1000").Select
'příkaz kopírování
Selection.Copy

Application.ScreenUpdating = False

'aktivace cílového souboru

Windows("Ko.xlsx").Activate
ActiveWorkbook.LockServerFile
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    Sheets("lak").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
Sheets("lak").Select
Range("A2:V1000").Select

    Columns("J:L").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.00"
    Columns("J:L").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A2").Select
    Windows("Ko ceník .xlsm").Activate
    Range("A2").Select
    Windows("Ko.xlsx").Activate
    Range("A2:T988").Select
    ActiveWorkbook.Worksheets("lak").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("lak").Sort.SortFields.Add2 Key:=Range("A2:A988") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("lak").Sort
        .SetRange Range("A1:T988")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2").Select
    Sheets("Ceník Ko").Select
    Range("A2").Select


'uzavření cílového souboru
 Windows("Ko.xlsx").Activate
 
 
  'For Each w In Application.Workbooks
   ' w.Save
   ' Next w
  ' Application.Quit
   ' ActiveWorkbook.Close
   
  'Přejde na první prázdnou bunku
 
   Cells(Rows.Count, 1).End(xlUp).Offset(1).Select


End Sub



Reklama
  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Ovladač síťového adaptéru
    od Petrfoo » 03 lis 2018 15:23 » v Windows 10, 8, 7, Vista, XP…
    1
    405
    od xbs
    03 lis 2018 15:51
  • Jaký ovladač sitoveho adapteru
    od Gogo1958 » 06 dub 2019 20:07 » v Sítě - hardware
    1
    301
    od Pic
    06 dub 2019 22:23
  • Excel - VBA - Makro - odeslání dat ze souboru A do souboru B
    od Pavel Křivánek » 26 lis 2018 15:04 » v Kancelářské balíky
    3
    827
    od MePExG
    28 lis 2018 21:30
  • Blokování USB portů, ale povolení některých konkrétních USB zařízení
    od nover » 16 lis 2018 09:31 » v Problémy s hardwarem
    0
    560
    od nover
    16 lis 2018 09:31
  • Instalace souboru
    od MaN0fy » 26 bře 2019 18:46 » v Windows 10, 8, 7, Vista, XP…
    4
    402
    od petr22
    26 bře 2019 20:20

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

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 0 hostů