Just nu i M3-nätverket
Gå till innehåll

Johan Novis

Medlem
  • Antal inlägg

    1
  • Gick med

  • Senaste besök

Om Johan Novis

  • Medlemstitel
    Nykomling

Senaste profilbesöken

Blocket med senaste besökare är inaktiverat och visas inte för andra besökare.

  1. Hej Har skrivit nedanstående kod. Den gör enkelt berättat: Skapa ett nytt Exceldokument med valfritt namn Kopiera över 2 flikar Bryt länkarna mellan dokumenten. Koden funkar perfekt på min dator men inte på flera mina arbetskollegors. Jag förstår inte varför. Kan någon hjälpa mig? Public NWB, AWB As Workbook Public PWD As String Function Break_Links(O As String, W As Integer, R As Integer, C As Integer) As Integer Dim R_, C_ As Integer NWB.Worksheets(W).Unprotect PWD C_ = 1 While C_ <= C R_ = 1 While R_ <= R Formula_ = NWB.Worksheets(W).Cells(R_, C_).Formula If Formula_ <> "" Then If InStr(1, Formula_, O) > 0 Then Value_ = NWB.Worksheets(W).Cells(R_, C_).Value NWB.Worksheets(W).Cells(R_, C_).Formula = "" NWB.Worksheets(W).Cells(R_, C_).Value = Value_ End If End If R_ = R_ + 1 Wend C_ = C_ + 1 Wend NWB.Worksheets(W).Protect PWD Break_Links = 1 End Function Sub Make_New_Workbook() Dim WS As Worksheet Set AWB = ThisWorkbook PWD = "123" 'Password för att låsa och låsa upp worksheet Dim P, N, O As String P = Application.ActiveWorkbook.Path N = InputBox("Ange dokumentets namn!" & Chr(13) & "(Filen sparas i mappen: " & P & ")", "Filnamn:") If N <> vbNullString Then If Dir(P & "\" & N & ".xls*") <> "" Then A = MsgBox("Filen existerar redan!" & Chr(13) & "(Stäng och flytta eller radera den,)", vbCritical, "Error:") Exit Sub End If Set NWB = Workbooks.Add AWB.Worksheets("Presentation verkstad skicka").Copy After:=NWB.Worksheets(NWB.Worksheets.Count) AWB.Worksheets("Månadsmål skicka").Copy After:=NWB.Worksheets(NWB.Worksheets.Count) Application.DisplayAlerts = False NWB.Worksheets(1).Delete NWB.Worksheets(1).Select Application.DisplayAlerts = True NWB.SaveAs (P & "\" & N) O = AWB.Name Result = Break_Links(O, 1, 50, 20) Result = Break_Links(O, 2, 50, 20) End If End Sub
×
×
  • Skapa nytt...