Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Kasım 2008 Perşembe

MS Windows® Environ Statement



'UserForm1

'Add Tools on UserForm1: Label1...3, ListBox1
Option Explicit
Dim i As Single
Dim No As Double
Dim Dizi As String

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®]Windows® Environ Statement"
Application.Visible = False
With ListBox1
.ColumnCount = 3
.ColumnWidths = "36;120;436"
End With
Call EnvironStatement
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
End Sub
Sub EnvironStatement()
On Error Resume Next
ListBox1.Clear
For i = 1 To 30
Dizi = VBA.Environ(i)
No = Application.WorksheetFunction.Find("=", Dizi, 1)
ListBox1.AddItem i
ListBox1.List((i - 1), 1) = VBA.Mid(Dizi, 1, (No - 1))
ListBox1.List((i - 1), 2) = VBA.Right(Dizi, VBA.Len(Dizi) - No)
Next i
End Sub

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

1 Kasım 2008 Cumartesi

Color_Number



'Module1

Option Explicit
Dim i As Integer
Dim Alan As Range, Eleman As Range

Sub Renk_No()
On Error Resume Next
Set Alan = Sheets("Sayfa1").UsedRange
For i = 1 To 56
For Each Eleman In Alan
If Eleman.Value = i Then
Eleman.Offset(0, 1).Interior.ColorIndex = i
End If
Next Eleman
Next i
End Sub

Blog Arşivi

Gadget

Bu içerik henüz şifreli bağlantı üzerinden kullanılamıyor.

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
Anadolu Üniversitesi Açık Öğretim Fakültesi