• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücreye çift tıklama makrosu

  • Konbuyu başlatan Konbuyu başlatan asdsxx
  • Başlangıç tarihi Başlangıç tarihi
asdsxx

asdsxx

Altın Üye
Katılım
22 Mayıs 2012
Mesajlar
510
Excel Vers. ve Dili
Excel 2016 Türkçe
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
 
Neden hücrenin içine girme ihtiyaci oluştu?
 
Korhan Ayhan' Alıntı:
Neden hücrenin içine girme ihtiyaci oluştu?
Genişletmek için tıkla ...

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.
 
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 Ayhan' Alıntı:
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
Genişletmek için tıkla ...

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' Alıntı:
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
Genişletmek için tıkla ...

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ı:

Hücre içindeki Boş satırları silme

Arkadaşlar excelde bir sütun içinde yüzlerce hücrede metin paragraflar var. Bu paragraflar arasında bazen boş satırlar var. (boş hücre değil) hücre içinde boş satırları silmemiz mümkün mü? Bu iş makro ile yapılabilir mi?
www.excel.web.tr www.excel.web.tr
14. mesaj
RBozkurt Beyin yazığı kod: 18. mesaj
 
Küçük bir revize yaptım. Deneyiniz.
 
Korhan Ayhan' Alıntı:
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
Genişletmek için tıkla ...

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.
 
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.
 
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

İndir örnek

Dosyayı indir örnek
dosya.co
 
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 Ayhan' Alıntı:
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
Genişletmek için tıkla ...

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.

İndir Başlık düzeltme

Dosyayı indir Başlık düzeltme
dosya.co
 
Son düzenleme:
necati' Alıntı:
If Right(Copy_Data, 1) = Chr(10) Then
Copy_Data = Left(Copy_Data, Len(Copy_Data) - 1)
End If
Genişletmek için tıkla ...

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.
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst