Excel Farklı Sayfada Hücre içi yazı tamamlama

[KİMSESİZ YAŞAR]

Oluşturulan Excel formatında hücre içi yazı tamamlama işlemini yeni açtığım excel sayfalarında da kullanmak istiyorum bunu nasıl yaparım ?

Yardımlarınız İçin Şimdiden Teşekkür Ederim.

Kullanılan kod:

Option Explicit
Public deg As Variant
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (ByRef lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare PtrSafe Function TranslateMessage Lib "user32" (ByRef lpMsg As MSG) As Long
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE As Long = &H1
Private Const WM_CHAR As Long = &H102
Private bExitLoop As Boolean
Public pTemp As String
Public GlobalArray As Variant
Sub TrackKeyPressInit()
Dim msgMessage As MSG
Dim bCancel As Boolean
Dim iKeyCode As Integer
Dim lXLhwnd As Long
Dim A As Variant
If ActiveSheet.Name <> "Sayfa2" Then Exit Sub
GlobalArray = Array(19, 20, 46, 40, 35, 13, 27, 36, 45, 37, 144, 34, 33, 39, 145, 9, 38)
On Error GoTo errHandler:
Application.EnableCancelKey = xlErrorHandler
bExitLoop = False
lXLhwnd = FindWindow("XLMAIN", Application.Caption)
Do
WaitMessage
For Each A In Sayfa1.Range("a2:a" & Sayfa1.Range("a65536").End(3).Row)
If A Like deg & "*" Then
deg = A.Value
Exit Sub
End If
Next
errHandler:
DoEvents
Loop Until bExitLoop
End Sub
Sub StopKeyWatch()
If ActiveSheet.Name <> "Sayfa2" Then Exit Sub
bExitLoop = True
End Sub
Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, ByVal KeyCode As Integer, ByVal Target As Range, Cancel As Boolean)
If ActiveSheet.Name <> "Sayfa2" Then Exit Sub
If Not Intersect(Target, Range("A1:A1000")) Is Nothing Then
If IsInArray(KeyAscii, GlobalArray) Then
StopKeyWatch
Cancel = True
SendKeys "{ENTER}"
Else
pTemp = pTemp & Chr(KeyAscii)
Target.Offset(0) = pTemp
Target.Offset(1) = pTemp
Cancel = True
Application.ScreenUpdating = True
End If
Else
StopKeyWatch
End If
End Sub
Function IsInArray(stringToBeFound As Integer, arr As Variant) As Boolean
If ActiveSheet.Name <> "Sayfa2" Then Exit Sub
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

 

[KİMSESİZ YAŞAR]

Birde kullanılan bu kod var

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row < 2 Or Target.Row > 5000 Then Exit Sub
If Target = Empty Then Exit Sub
deg = Target
pTemp = ""
TrackKeyPressInit
Application.EnableEvents = False
Target = deg
Application.EnableEvents = True
deg = Empty
Target.Select
End Sub

 

[Korhan Ayhan]

Merhaba,

Kod aşağıdaki satır yardımıyla sadece Sayfa2 de çalışacak şekilde ayarlanmış.. Bu satırı düzenleyerek çalışmasını istediğiniz sayfaları ekleyebilirsiniz.

Not : Aşağıdaki satır birden fazla yerde kullanılmış. Hepsini aynı şekilde düzenlemeniz gerekir.

If ActiveSheet.Name <> "Sayfa2" Then Exit Sub

Eğer işlem yapılacak sayfa sayısı çok ise çalışmaması gereken sayfaları tanımlamak daha akıllıca olabilir.

Select-Case-End Select döngüsü bu anlamda kullanışlı olabilir.

 

[KİMSESİZ YAŞAR]

If ActiveSheet.Name <> "Sayfa2" Then Exit Sub

Korhan Bey yukarıda yazmış olduğum formül yerine ne kullanabilirim ?
sizden anladığım bu formul sadece tek sayfada çalışmasını sağlıyor.
Yardımcı olursanız sevinirim.

 

[Korhan Ayhan]

Kodun çalışmaması gereken sayfa sayısı nedir?
Kodun çalışması gereken sayfa sayısı nedir?