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
↧