Bintang
Altın Üye
- Katılım
- 31 Ekim 2006
- Mesajlar
- 344
- Excel Vers. ve Dili
- Microsoft Office Professional Plus 2019,Türkçe
- Altın Üyelik Bitiş Tarihi
- 05-09-2029
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Üstadım olmadı malesef.Merhaba,
Formüllerle ilgiliyse;
Ctrl+F (bul), aranan bölümüne :\ yazın, seçeneklerden çalışma kitabını işaretleyin ve tümünü bul ile dışardan veri aldığını formülleri bulup silebilir siniz.
Not: Silmeden önce bulduğunuz formülleri kontrol etmenizi tavsiye ederim.
Üstad yaptım malesef ancak dosyayı açınca bağlantıları düzenle mesaj kutucuğu hala gelmeye devam ediyor.data sekmesinde "bağlantıları düzenle" veya "sorgular ve bağlantılar" diye bir seçenek var. oraya bakarsanız görebilirsiniz diye tahmin ediyorum.
hocam bağlantıları düzenle seçeneğine tıklayın, açılan pencerede resimde gösterdiğim şekilde başlangıçta "uyarıları gösterme ve güncelleme" (ikinci seçenek) seçeneğini işaretleyin. Türkçe kullanıyorsanız karşılığı nasıldır bilmiyorum ama resimden anlaşılır diye tahmin ediyorum.Üstad yaptım malesef ancak dosyayı açınca bağlantıları düzenle mesaj kutucuğu hala gelmeye devam ediyor.
Sub BreakLinks()
'Updateby20140318
Dim wb As Workbook
Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link
End If
End Sub
Üstadım baştan aşağı dediklerinizi hepsini kontrol ettim malesef olmadıAşağıdaki durumları kontrol etmelisiniz.
AD TANIMLAMA
VERİ DOĞRULAMA
KOŞULLU BİÇİMLENDİRME BAĞLANTILARI
FORMÜL BAĞLANTILARI
ÖZET TABLO-GRAFİK BAĞLANTILARI
Üstadım elinize emeğinize sağlık malesef olmadı.Belki yardımcı olur deneyin.
Kod:Sub BreakLinks() 'Updateby20140318 Dim wb As Workbook Set wb = Application.ActiveWorkbook If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then For Each link In wb.LinkSources(xlExcelLinks) wb.BreakLink link, xlLinkTypeExcelLinks Next link End If End Sub
Sub T_Ad_Sil_3()
On Error Resume Next
On Error GoTo 10
Dim ONAY As Byte
For Each adlar In ThisWorkbook.Names
If (adlar.Name Like "*Print_Titles*" Or adlar.Name Like "*Print_Area*") Then GoTo 10
adlar.Delete
10:
Next
End Sub
sub temizle()
ActiveSheet.DrawingObjects.Delete
End sub
Sub listLinks()
aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
Sheets.Add
shtName = ActiveSheet.Name
Set summaryWS = ActiveWorkbook.Worksheets(shtName)
summaryWS.Range("A1") = "Worksheet"
summaryWS.Range("B1") = "Cell"
summaryWS.Range("C1") = "Formula"
summaryWS.Range("D1") = "Workbook"
summaryWS.Range("E1") = "Link Status"
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> summaryWS.Name Then
For Each Rng In ws.UsedRange
If Rng.HasFormula Then
For j = LBound(aLinks) To UBound(aLinks)
filePath = aLinks(j) 'LinkSrouces returns full file path with file name
Filename = Right(filePath, Len(filePath) - InStrRev(filePath, "\")) 'extract just the file name
filePath2 = Left(aLinks(j), InStrRev(aLinks(j), "\")) & "[" & Filename & "]" 'file path with brackets
If InStr(Rng.Formula, filePath) Or InStr(Rng.Formula, filePath2) Then
nextrow = summaryWS.Range("A" & Rows.Count).End(xlUp).Row + 1
summaryWS.Range("A" & nextrow) = ws.Name
summaryWS.Range("B" & nextrow) = Replace(Rng.Address, "$", "")
summaryWS.Hyperlinks.Add Anchor:=summaryWS.Range("B" & nextrow), Address:="", SubAddress:="'" & ws.Name & "'!" & Rng.Address
summaryWS.Range("C" & nextrow) = "'" & Rng.Formula
summaryWS.Range("D" & nextrow) = filePath
summaryWS.Range("E" & nextrow) = linkStatusDescr(ActiveWorkbook.LinkInfo(CStr(filePath), xlLinkInfoStatus))
Exit For
End If
Next j
For Each namedRng In Names
If InStr(Rng.Formula, namedRng.Name) Then
filePath = Replace(Split(Right(namedRng.RefersTo, Len(namedRng.RefersTo) - 2), "]")(0), "[", "") 'remove =' and range in the file path
nextrow = summaryWS.Range("A" & Rows.Count).End(xlUp).Row + 1
summaryWS.Range("A" & nextrow) = ws.Name
summaryWS.Range("B" & nextrow) = Replace(Rng.Address, "$", "")
summaryWS.Hyperlinks.Add Anchor:=summaryWS.Range("B" & nextrow), Address:="", SubAddress:="'" & ws.Name & "'!" & Rng.Address
summaryWS.Range("C" & nextrow) = "'" & Rng.Formula
summaryWS.Range("D" & nextrow) = filePath
summaryWS.Range("E" & nextrow) = linkStatusDescr(ActiveWorkbook.LinkInfo(CStr(filePath), xlLinkInfoStatus))
Exit For
End If
Next namedRng
End If
Next Rng
End If
Next
Columns("A:E").EntireColumn.AutoFit
lastrow = summaryWS.Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastrow
If ActiveSheet.Range("E" & r).Value = "File missing" Then
countBroken = countBroken + 1
End If
Next
If countBroken > 0 Then
sInput = MsgBox("Do you want to remove broken links of status 'File missing'?", vbOKCancel + vbExclamation, "Warning")
If sInput = vbOK Then
For r = 2 To lastrow
If ActiveSheet.Range("E" & r).Value = "File missing" Then
Sheets(Range("A" & r).Value).Range(Range("B" & r).Value).ClearContents
dummy = MsgBox(countBroken & " broken links removed", vbInformation)
End If
Next
End If
End If
Else
MsgBox "No external links"
End If
End Sub
Public Function linkStatusDescr(statusCode)
Select Case statusCode
Case xlLinkStatusCopiedValues
linkStatusDescr = "Copied values"
Case xlLinkStatusIndeterminate
linkStatusDescr = "Unable to determine status"
Case xlLinkStatusInvalidName
linkStatusDescr = "Invalid name"
Case xlLinkStatusMissingFile
linkStatusDescr = "File missing"
Case xlLinkStatusMissingSheet
linkStatusDescr = "Sheet missing"
Case xlLinkStatusNotStarted
linkStatusDescr = "Not started"
Case xlLinkStatusOK
linkStatusDescr = "No errors"
Case xlLinkStatusOld
linkStatusDescr = "Status may be out of date"
Case xlLinkStatusSourceNotCalculated
linkStatusDescr = "Source not calculated yet"
Case xlLinkStatusSourceNotOpen
linkStatusDescr = "Source not open"
Case xlLinkStatusSourceOpen
linkStatusDescr = "Source open"
Case Else
linkStatusDescr = "Unknown status"
End Select
End Function
Bunu denediniz mi?hocam bağlantıları düzenle seçeneğine tıklayın, açılan pencerede resimde gösterdiğim şekilde başlangıçta "uyarıları gösterme ve güncelleme" (ikinci seçenek) seçeneğini işaretleyin. Türkçe kullanıyorsanız karşılığı nasıldır bilmiyorum ama resimden anlaşılır diye tahmin ediyorum.
Ekli dosyayı görüntüle 236870