Složku na Sharepointu mám synchronizovanou v PC.
Problém je v tom, že se mi sešit otevre ale jenom pro čtení a už se mi neuloží.
Používal jsem kod ktery mi do nedavna fungoval. "ActiveWorkbook.LockServerFile"
Nepomohla ani zmena chraneného zobrazení.
Cesty a nazvy listu a souboru jsem v tomto kodu smazal.
Díky moc za radu
Kód: Vybrat vše
Sub lkak()
'
' Makro1 Makro
Application.ScreenUpdating = False
'umístění zdroje (cesta)
ChDir "Z:"
'otevření zdrojového souboru
Workbooks.Open Filename:="Z: ceník .xlsm"
'název listu
Sheets("Ceník ").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("Import a aktual.xlsm").Activate
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("K").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'vyhledání posledního volného řádku
'Range("D500000").End(xlUp).Offset(1).Select
'vložení kopírované oblasti
'ActiveSheet.Paste
Columns("J:U").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"
Columns("J:U").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("ceník .xlsm").Activate
Range("A2").Select
Windows("Import a aktual .xlsm").Activate
Range("A2:U988").Select
ActiveWorkbook.Worksheets("K").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("K").Sort.SortFields.Add2 Key:=Range("A2:A988") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("K").Sort
.SetRange Range("A1:T988")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
'Sheets("Ceník ").Select
Range("A2").Select
ActiveWorkbook.LockServerFile
'uzavření cílového souboru
Windows("Import a aktual .xlsm").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
