Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Kasım 2008 Pazartesi

Link Control




'UserForm1

'Add Tools on UserForm1: Label1, Label2, ListBox1, ListBox2, Image1, label3
Option Explicit
Dim i As Single, ii As Single
Dim Satır As Double, No As Double, Boy0 As Double, Boy1 As Double, Boy2 As Double, Yer As Double
Dim Bağ As Variant
Dim Hücre As Range
Dim HücreMetin As String, BağMetin As String, DosyaMetin As String, Taranan As String

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Link Control..."
BağlantıAraştır
End Sub
Private Sub ListBox1_Click()
On Error GoTo Hata:
No = 0
With ListBox2
.Clear
.ColumnCount = 2
.ColumnWidths = "72;24"
End With
Satır = ListBox1.ListIndex
BağMetin = ListBox1.List(Satır, 0)
Boy1 = VBA.Len(BağMetin)
For ii = 1 To Boy1
If VBA.Left(VBA.Right(BağMetin, ii), 1) = "\" Then
DosyaMetin = VBA.Right(BağMetin, (ii - 1))
Boy0 = VBA.Len(DosyaMetin)
Exit For
End If
Next ii
i = 0
For i = 1 To ThisWorkbook.Worksheets.Count
For Each Hücre In Sheets(i).UsedRange
HücreMetin = Hücre.Formula
If (HücreMetin <> "") Then
Boy2 = VBA.Len(HücreMetin)
For ii = 1 To Boy2
Taranan = VBA.Left(VBA.Right(HücreMetin, ii + Boy0), Boy0)
If Taranan = DosyaMetin Then
ListBox2.AddItem Sheets(i).Name
ListBox2.List(No, 1) = Hücre.Address
No = No + 1
Exit For
End If
Next ii
End If
Next Hücre
Next i
Exit Sub
Hata:
ListBox2.Clear
End Sub
Sub BağlantıAraştır()
On Error GoTo Hata:
Bağ = ActiveWorkbook.LinkSources(xlOLELinks)
If Not IsEmpty(Bağ) Then
For i = 1 To UBound(Bağ)
BağMetin = Bağ(i)
ListBox1.AddItem Bağ(i)
Next i
End If
Bağ = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(Bağ) Then
For i = 1 To UBound(Bağ)
BağMetin = Bağ(i)
ListBox1.AddItem BağMetin
Next i
End If
Hata:
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul