ActiveWorkbook.BreakLink

[scanacc]

Non so se occorre che posti l'intero codice ma intanto provo così.
Ho creato questa macro che ha al suo interno questa scritta

Codice: Seleziona tutto

    ActiveWorkbook.BreakLink Name:="C:\FOCUS FB\Analisi 4.8n.xlsm", Type _
        :=xlExcelLinks

Dato che spesso cambio il nome al file "C:\FOCUS FB\Analisi 4.8n.xlsm" vorrei sapere, affinchè non vada in debug, se esiste un'altro comando da usare.
Grazie

[Anthony47]

Beh, se solo vuoi che non vada in debug, usa On Error:

Codice: Seleziona tutto

On Error Resume Next
 ActiveWorkbook.BreakLink Name:="C:\FOCUS FB\Analisi 4.8n.xlsm", Type _
        :=xlExcelLinks
On Error GoTo 0

Se invece vuoi interrompere il primo link, se esiste, allora potresti usare

Codice: Seleziona tutto

XLLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
If Not IsEmpty(XLLinks) Then
 ActiveWorkbook.BreakLink Name:=XLLinks(1), Type _
        :=xlExcelLinks
End If


Ciao

[scanacc]

In realtà vorrei che il comando facesse la cosa per la quale è stato creato ma con nome diverso.
Anzichè farlo sul file C:\FOCUS FB\Analisi 4.8n.xlsm, vorrei lo facesse su C:\FOCUS FB\NOME CAMBATO.xlsm

[Anthony47]

In realtà vorrei che il comando facesse la cosa per la quale è stato creato ma con nome diverso.

Mi verrebbe allora da dire: "modifica l'indirizzo del link che vuoi interrompere", ma temo che non sia quello che t'aspetti, anche se non hai detto che cosa ti aspetti...

Per portarmi avanti, vedi se questo codice ti aiuta:

Codice: Seleziona tutto

Dim XLLinks, Rispo
'
XLLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
If Not IsEmpty(XLLinks) Then
    mmsg = "Inserire il Numero del link da interrompere:" & vbCrLf
    For I = 1 To UBound(XLLinks)
        mmsg = mmsg & Format(I, "0-") & XLLinks(I) & vbCrLf
    Next I
    Rispo = Application.InputBox(mmsg, "Seleziona", Type:=1)
    If Rispo = False Then Exit Sub
    If Rispo > UBound(XLLinks) Or Rispo < 1 Then
        MsgBox ("Scelta inesistente, procedura abortita")
        Exit Sub
    End If
    ActiveWorkbook.BreakLink Name:=XLLinks(Int(Rispo)), Type:=xlExcelLinks
End If

Questo dovrebbe permetterti di scegliere quale link fissare

Non so cos'altro fa la tua macro, quindi non so se l'integrazione del nuovo codice e' immediata

Se anche quanto proposto "non c'azzecca" allora rassegnati: devi dire qualcosa di piu' sul tuo file e sul processo che vuoi realizzare

Ad esempio, per cominciare: quanti link ci sono nel tuo file? C'e' una regola per dire "questo rimane come link e questo lo congeliamo"?

Ciao

[scanacc]

Forse è meglio se posto la macro:

Codice: Seleziona tutto

Sub ESPORTA_EXCEL()
    Dim MyDir As String, NomeFile As String
    Dim FileExist As Boolean
   
    Application.ScreenUpdating = False
    Sheets("FOCUS FB").Select
    Sheets("FOCUS ORIGINALE").Visible = True
   
    Sheets("FOCUS ORIGINALE").Select
    MyDir = "C:\FOCUS FB\a ANALISI SVOLTE\"
    NomeFile = Range("D14").Value

 
   Application.DisplayAlerts = False
 
    ActiveSheet.Copy


    With ActiveWorkbook

        .SaveAs Filename:=MyDir & "" & NomeFile
        .Close savechanges:=False
       

   End With
    Sheets("FOCUS FB").Select
    Range("D14").Select
    'MESSO ORA
    Workbooks.Open Filename:="C:\FOCUS FB\a ANALISI SVOLTE\" & Range("D14").Value
    Selection.Copy
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' CAMBIO NOME AL FOGLIO
    Sheets("FOCUS ORIGINALE").Name = "FOCUS FB"
'FORMATTO MEGLIO
    'Workbooks.Open Filename:="C:\FOCUS FB\a ANALISI SVOLTE\" & Range("D14").Value
    Range("Q40:AF46,AG66:AN74,X87:AN101,M130:M164,AH133:AN149").Select
    Selection.NumberFormat = "_-$* #,##0.00_-;-$* #,##0.00_-;_-$* ""-""??_-;_-@_-"
    Range("D14").Select
'messo il font a 6 di grandezza
    Range("R131:U131").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 6
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("V131:Y131").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 6
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

    Range("D14").Select
'messa ora
    Selection.SpecialCells(xlCellTypeConstants, 23).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
'messa 12 11
    ActiveWorkbook.BreakLink Name:="C:\FOCUS FB\Analisi 4.8o.xlsm", Type _
        :=xlExcelLinks
    Range("D13").Select
   
    ActiveWorkbook.Save
    ActiveWindow.Close
    Sheets("FOCUS ORIGINALE").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("FOCUS FB").Select
    Range("D13").Select

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True '

    MsgBox "Report creato con successo"
End Sub

[scanacc]

Se per esempio dovessi cambiare il nome al file che contiene questa macro (Analisi 4.8o.xlsm) e dal quale parte il comando, va in debug il sistema e io, manualmente, devo tutte le volte cambiare il nome che compare dentro la macro.
A mo di esempio in Analisi 4.8p.xlsm oppure Analisi 4.8r.xlsm etc etc
Spero di essere stato chiaro
PS
Dico la verità, non volove postarlo perchè mi immagino come rideranno di me chi sa davvero programmare

[Anthony47]

Quindi tu parti da un file che contiene un certo foglio ("FOCUS ORIGINALE"), che contiene "collegamenti" ad altri fogli dello stesso file.
Di questo certo foglio ne crei una copia in un nuovo workbook; cosi' facendo, i collegamenti ad altri fogli del file diventano pero' collegamenti esterni; tu vorresti che questi collegamenti esterni vengano eliminati e sostituiti col valore corrente.
Se e' cosi' allora mi pare che il nuovo workbook avra' sempre e solamente 1 solo collegamento esterno (verso il file di partenza), per cui dovrebbe bastare usare il secondo suggerimento che diedi nella mia prima risposta. Cioe' sostituire l'attuale istruzione (spalmata su 2 righe) ActiveWorkbook.BreakLink Name:="C:\FOCUS FB\Analisi 4.8o.xlsm", Type:=xlExcelLinks con

Codice: Seleziona tutto

XLLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
If Not IsEmpty(XLLinks) Then
 ActiveWorkbook.BreakLink Name:=XLLinks(1), Type _
        :=xlExcelLinks
End If


Se vuoi qualcosa di piu' analitico, allora potresti intervenire nella parte iniziale della macro con queste due aggiunte:

Codice: Seleziona tutto

'altre istruzioni
    NomeFile = Range("D14").Value
    Application.DisplayAlerts = False
    cwb = ActiveWorkbook.FullName                       '++++
    ActiveSheet.Copy
    With ActiveWorkbook
        .SaveAs Filename:=MyDir & "" & NomeFile
        .BreakLink Name:=cwb, Type:=xlExcelLinks    '++++
        .Close savechanges:=False
    End With
'altre istruzioni


(vedi le righe marcate +++)
Cioe' tieni conto del nome del file da cui sei partito e lo usi per rompere il link. Potrai cosi' eliminare la successiva istruzione ActiveWorkbook.BreakLink Name:="C:\FOCUS\etc etc

Spero che abbia indovinato qualcosa...

Ciao

[scanacc]

Come sempre hai "indovinato" tutto!
Ho usato il tuo primo suggerimento e tutto funziona alla grande.
Ciao e grazie di nuovo