Hücreye çift tıklama makrosu

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
487
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
Arkadaşlar bir çalışma için küçük bir makroya ihtiyacım var
İşlem şu:
Klavye kısayol tuşuna CTRL+V yani yapıştır tuşuna bastığım zaman:
imleç bulunduğu hücrede çift tıklama (hücrenin içine) yapıp yapıştırma yapacak ve bir alt hücreye (Enter kullanmadan) gidecek
Yani yapıştır (CTRL+V) fonksiyonunun işlevini genişleteceğiz
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Neden hücrenin içine girme ihtiyaci oluştu?
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
487
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
Neden hücrenin içine girme ihtiyaci oluştu?
Korhan Bey selamlar
bir çalışma yapıyorum. Önceki mesajlarımda da bahsettim (https://www.excel.web.tr/threads/huecre-icindeki-bos-satirlari-silme.205706/) farklı yerden kopyaladığım bir bütünlük içeren metinleri (birden fazla paragraf var) aynı hücreye yapıştırmam gerekiyor. Doğrudan yapıştırınca bazen 7-8 paragraflı metin o kadar hücreye parçalanarak yapışıyor. Ben işi hızlandırmak için istiyorum.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki kodu deneyiniz.

ThisWorkbook bölümüne;

C++:
Option Explicit

Private Sub Workbook_Activate()
    Application.OnKey "^{v}", "My_Paste"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^{v}"
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "^{v}"
End Sub

Private Sub Workbook_Open()
    Application.OnKey "^{v}", "My_Paste"
End Sub
Boş bir modüle;
C++:
Option Explicit

Sub My_Paste()
    Dim Clipboard As Object, Copy_Data As Variant
 
    Set Clipboard = VBA.CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Clipboard.GetFromClipboard
    Copy_Data = Clipboard.GetText
    ActiveCell = IIf(ActiveCell = "", Copy_Data, ActiveCell & vbLf & Copy_Data)
    ActiveCell.Offset(1).Select
    Set Clipboard = Nothing
End Sub
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
487
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
Aşağıdaki kodu deneyiniz.

ThisWorkbook bölümüne;

C++:
Option Explicit

Private Sub Workbook_Activate()
    Application.OnKey "^{v}", "My_Paste"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^{v}"
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "^{v}"
End Sub

Private Sub Workbook_Open()
    Application.OnKey "^{v}", "My_Paste"
End Sub
Boş bir modüle;
C++:
Option Explicit

Sub My_Paste()
    Dim Clipboard As Object, Copy_Data As Variant
   
    Set Clipboard = VBA.CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Clipboard.GetFromClipboard
    Copy_Data = Clipboard.GetText
    ActiveCell = ActiveCell & vbCr & Copy_Data
    Set Clipboard = Nothing
End Sub
Korhan Bey ilginize çok teşekkür ederim. Kod çalışıyor.
Bu koda bir ekleme ile yapıştırma işleminden sonra imleç bir alttaki hücreye gidebilir mi? Yani kod'a "Enter" komutu eklenecek.
Selamlar...
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kodu güncelledim. Deneyiniz.
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
487
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
Aşağıdaki kodu deneyiniz.

ThisWorkbook bölümüne;

C++:
Option Explicit

Private Sub Workbook_Activate()
    Application.OnKey "^{v}", "My_Paste"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^{v}"
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "^{v}"
End Sub

Private Sub Workbook_Open()
    Application.OnKey "^{v}", "My_Paste"
End Sub
Boş bir modüle;
C++:
Option Explicit

Sub My_Paste()
    Dim Clipboard As Object, Copy_Data As Variant
  
    Set Clipboard = VBA.CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Clipboard.GetFromClipboard
    Copy_Data = Clipboard.GetText
    ActiveCell = ActiveCell & vbCr & Copy_Data
    ActiveCell.Offset(1).Select
    Set Clipboard = Nothing
End Sub
Korhan Bey sizi tekrar rahatsız ediyorum. Kusura bakmayın.
yazdığınız kod çok güzel çalıştı. Fakat başka bir kodun düzelttiği işleme engel oldu. Böyle bir durum olabilir mi?
Daha önce çift tıklayarak yapıştırdığım verileri (Sizin koddan önce) aşağıdaki adreste 14. mesaj ile anlatmak istediğim sıkıntımı Sağolsun "RBozkurt" Bey bir kod yazarak çözmüştüm. Şimdi ise o kod çalışmıyor. Normal önceki sitemde (Çift tıklayarak yaptığım çalışmalarda çalışıyor.
önceki konu mesajı:
14. mesaj
RBozkurt Beyin yazığı kod: 18. mesaj
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Küçük bir revize yaptım. Deneyiniz.
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
487
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
Aşağıdaki kodu deneyiniz.

ThisWorkbook bölümüne;

C++:
Option Explicit

Private Sub Workbook_Activate()
    Application.OnKey "^{v}", "My_Paste"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^{v}"
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "^{v}"
End Sub

Private Sub Workbook_Open()
    Application.OnKey "^{v}", "My_Paste"
End Sub
Boş bir modüle;
C++:
Option Explicit

Sub My_Paste()
    Dim Clipboard As Object, Copy_Data As Variant

    Set Clipboard = VBA.CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Clipboard.GetFromClipboard
    Copy_Data = Clipboard.GetText
    ActiveCell = IIf(ActiveCell = "", Copy_Data, ActiveCell & vbLf & Copy_Data)
    ActiveCell.Offset(1).Select
    Set Clipboard = Nothing
End Sub
Korhan Bey selamlar
yukarıdaki son kodda farkettiğim bir durum
hücreye veriyi yapıştırdıktan sonra en alta boş satır açıyor. Sizin boş satırları silmek için hazırladığınız kod ise bu boş satırı silmiyor.
Bu durum özellikle ComboBox'da veri seçerken çift paragraf gibi gördüğü için hata veriyor.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Son satırda boşluk oluşmasını gerektirecek bir durum göremiyorum.

Böyle olan küçük bir örnek dosya paylaşırsanız boşluğu kaldırma kodlarına belki ek yapabiliriz.
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
487
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
Korhan Bey Selamlar
4 nolu mesajdaki kodun son hali ile hücreye bir beri yapıştırdığında çok ilginç durum oluyor
Eğer hücreye yapıştırılacak verinin içinde Alt+Enter li boş satır varsa sizin dediğiniz gibi bir sıkıntı olmuyor
Anca yapıştırılan veri tek paragraf ise yani içinde boş satır yoksa en alta boş satır ekliyor.
siz bunu denerseniz görünür. Ben "Clipboard Magic" isimli pano yapıştırıcı program ile bütün verileri kopyalayıp
sonra Excele aktarıyorum. İçinde boş satır olan veya olmayan karışık olarak. Ama boş satır yoksa kod en alta boş satır ekliyor.
size örnek bir foto göndereceğim
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu sorunlar sanırım tamamen yapıştırma işlemi yaptığınız alanla ilgili sorunlar.

Aşağıdaki kod metindeki fazla boşlukları kaldırır.

C++:
Option Explicit

Sub Clear_Trailing_Spaces()
    Dim My_Area As Range, Rng As Range
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Set My_Area = Nothing
    Set My_Area = Selection.SpecialCells(xlCellTypeConstants, 23)
    On Error GoTo 0
    
    If Not My_Area Is Nothing Then
        For Each Rng In My_Area.Cells
            Rng = WorksheetFunction.Trim(Rng)
        Next
    End If
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
487
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
Bu sorunlar sanırım tamamen yapıştırma işlemi yaptığınız alanla ilgili sorunlar.

Aşağıdaki kod metindeki fazla boşlukları kaldırır.

C++:
Option Explicit

Sub Clear_Trailing_Spaces()
    Dim My_Area As Range, Rng As Range
  
    Application.ScreenUpdating = False
  
    On Error Resume Next
    Set My_Area = Nothing
    Set My_Area = Selection.SpecialCells(xlCellTypeConstants, 23)
    On Error GoTo 0
  
    If Not My_Area Is Nothing Then
        For Each Rng In My_Area.Cells
            Rng = WorksheetFunction.Trim(Rng)
        Next
    End If
  
    Application.ScreenUpdating = True
  
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Korhan Bey ilginize teşekkür ederim.
Denedim ama çözüm olmadı. Size özelden gönderdiğim dosyada düzelltiğim kısımlarında olduğu dosyayı göndermişim ondan dolayı yanılma olmuş olabilir.
Hücrenin içine çift tıklatınca hücredeki boş satır görünüyor.
Size örnek dosyayı buraya ekliyorum.
 
Son düzenleme:

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Hangi hücre problemli?
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
487
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
Hangi hücre problemli?
İçinde veri olan hücrelerin neredeyse tamamı
mesela ilk hücrenin içine çift tıklatıp yön tuşu ile aşağı gidince hücrede bir boş satır (Alt+Enter) olduğu fark ediliyor
 

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
487
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
20-02-2025
If Right(Copy_Data, 1) = Chr(10) Then
Copy_Data = Left(Copy_Data, Len(Copy_Data) - 1)
End If
Necati Bey çalışma yaptıktan sonra sizin kodu denedim ama bir türlü çalıştıramadım.
Bunu yukarıdaki kodlardan birine mi ilave edeceğim. (Korhan Bey'in yapıştırma veya gereksiz Boşlukları kaldırma) yada farklı bir işlem ile mi çalışacak.
bağımsız bir makro gibi görünmüyor.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,591
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Benim önerdiğim koda ekleme yapın şeklinde paylaşım yapmışlar.

Deneyiniz.

C++:
Option Explicit

Sub My_Paste()
    Dim Clipboard As Object, Copy_Data As Variant

    Set Clipboard = VBA.CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Clipboard.GetFromClipboard
    Copy_Data = Clipboard.GetText
    If Right(Copy_Data, 1) = Chr(10) Then
        Copy_Data = Left(Copy_Data, Len(Copy_Data) - 1)
    End If
    ActiveCell = IIf(ActiveCell = "", Copy_Data, ActiveCell & vbLf & Copy_Data)
    ActiveCell.Offset(1).Select
    Set Clipboard = Nothing
End Sub
 
Üst