Povoleni úprav siťového souboru

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

Moderátor: Mods_senior

luko02420
Level 2
Level 2
Příspěvky: 218
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline
Kontakt:

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
  • Blokování stahovaných souborů
    od Riviera kid » 07 čer 2025 16:47 » v Windows 11, 10, 8...
    10
    4821
    od Riviera kid Zobrazit poslední příspěvek
    16 čer 2025 06:56
  • Program na hledání poškozených souborů JPG Příloha(y)
    od Rosta_Kolmix » 09 lis 2024 11:01 » v Design a grafické editory
    2
    4794
    od Minapark Zobrazit poslední příspěvek
    15 lis 2024 11:04
  • Velikost souboru a složek na disku
    od L.L » 05 úno 2025 11:50 » v Vše ostatní (sw)
    5
    3575
    od L.L Zobrazit poslední příspěvek
    05 úno 2025 17:42

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

Kdo je online

Uživatelé prohlížející si toto fórum: Google [Bot] a 1 host