• DİKKAT

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

Hücreye Buton Eklemeden Makro Çalıştırma

Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Herkese Merhaba,
Hücreye buton eklemeden makroyu çalıştırmak istiyorum. Bu olabilir mi acaba?
Teşekkür eder iyi çalışmalar dilerim.
 
Merhaba,
Alternatif olsun, ekteki dosyayı deneyiniz. Dosya açılınca F10 tuşuna basınız.
Not: Makrolar aktif olmalı...
Kod:
Sub Auto_Open()
Application.OnKey "{F10}", "MakroAdı"
End Sub

Sub MakroAdı()
MsgBox "Butonsuz makro çalıştırdınız.", , "Tebrikler!"
End Sub
 

Ekli dosyalar

Merhaba Ömer Bey, İlginiz için teşekkür ederim. Bir çok bilginizden çok istifade ettim. Bilgi paylaşımınızdan şükran duyuyorum.

Hücre içeriği değişme olmayacağı için bu benim yaptığım çalışmaya uygun değil. Ekte bulunan dosyada; seçtiğim dosyaları sağda bulunan mail adreslerine işaretleyerek gönderiyorum. Buraya kadar sorun yok program çalışıyor. Ancak bundan sonra 2 şey eklemek istedim yapamadım.

1. Seçtiğim dosyaları, iki mail adresini işaretleyerek göndermek istiyorum. (Ekteki dosyamda sadece bir maile gönderebiliyorum)

2. Liste uzayınca tekrar liste başına gidip MAIL GÖNDER Tuşuna tıklamak yerine "Firma ismine" yani hücresine çift tıklanınca MAIL GÖNDER Makrosu çalışsın.

Saygılar sunarım.
 

Ekli dosyalar

Merhaba.
E-posta gönderme kodlarının durumunu bilemiyorum ama aşağıdaki KOD blokunu,
alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan ekranda sağ taraftaki
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
kod blokunun altına (End Sub satırından sonraya) yapıştırın.
F sütunundaki hücreye fareyle çift tıklandığında karşısındaki E sütununda bir tane X varsa 1 kez, iki tane X varsa 2 kez kod çalışıyor.
Bence buradan devam etmelisiniz.

Tabi kod ustaları daha iyi/kullanışlı önerilerde bulunacaktır.
Outlook kullanmadığım için test edemiyorum.
Kod:
[COLOR="Blue"]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)[/COLOR]
If Intersect(Target, Range("F1:F" & Cells(65536, 4).End(3).Row)) Is Nothing Then Exit Sub
    If Cells(Target.Row, 5) = "X" Then
        [COLOR="Red"]Call email[/COLOR]
    End If[SIZE="2"]
    
    [/SIZE]If Cells(Target.Row + 1, 5) = "X" Then
        [COLOR="red"]Call email[/COLOR]
    End If
[COLOR="blue"]End Sub[/COLOR][SIZE="2"]

[/SIZE][COLOR="Red"]Sub email()[/COLOR]
    MsgBox "MAKRO ÇALIŞTI"
[COLOR="Red"]End Sub[/COLOR]
 
Son düzenleme:
Ömer Bey Merhaba,
Önce ilgi ve bilginiz için çok teşekkür ederim. Yazdığınız kod çalıştı tam istediğim gibi oldu. Sadece şu sorun var;

Hücreye Çift Tıklayıp 2 adet Mail Gönderiyor ama sadece ilk işaretlenen mail adresine gönderiyor. Yani 2. işaretlenen mail adresine göndermiyor.
Kısaca X işareti ile işaretlenen 2 AYRI email'e göndermesi GEREKİR.

Mucit beye de teşekkür eder, Bütün arkadaşlara saygılar sunarım.

Hoş ve esen kalın.
 
Son düzenleme:
Merhaba.

-- Öncelikle; gönderdiğim kod blokundaki Call mail satırılarCall KOD (mail gönderme makrosunun adı KOD idi) şeklinde değiştirmeniz lazım,
-- Emin değilim ve daha önce de belirttiğim gibi Outlook kullanmadığımdan deneme şansım da yok ama Modüle2'deki KOD adlı mail gönderme makrosunun aşağıdaki kısmına bir bilen dokunuşu lazım.
Kod:
    For s = 1 To S1.Cells(Rows.Count, "E").End(3).Row
        If UCase(S1.Cells(s, "E")) = "X" Then
            kime = S1.Cells(s, "D")
            Exit For
        End If
    Next s
 
Tekrar merhaba.
Sayfanın kod bölümüne; (daha önce gönderdiğim kod blokunu silip onun yerine)
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("F1:F" & Cells(65536, 4).End(3).Row)) Is Nothing Then Exit Sub
     Call KOD
End Sub

Module2'ye (dosyanızda var olan KOD adlı makroyu silip onun yerine)
Kod:
Sub KOD()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Dim S1 As Worksheet: Set S1 = Sheets("Mail")
    yol = "C:\Users\Ahmet\Desktop\Posta\"
    
    Dim dizi()
    For i = 1 To S1.Cells(Rows.Count, "B").End(3).Row
        If UCase(S1.Cells(i, "B")) = "X" Then
            n = n + 1
            ReDim Preserve dizi(n)
            dizi(n) = yol & S1.Cells(i, "A")
        End If
    Next i
    
If Cells(ActiveCell.Row, 5) = "X" Then
    kime1 = Cells(ActiveCell.Row, 4)
End If

If Cells(ActiveCell.Row + 1, 5) = "X" Then
    kime2 = Cells(ActiveCell.Row + 1, 4)
End If
    
    Dim xlOutlook   As Object
    Dim xlMail      As Object
    Set xlOutlook = CreateObject("Outlook.Application")
    Set xlMail = xlOutlook.CreateItem(0)
    
    With xlMail
        .To = kime1 & " ; " & kime2
        .Subject = " === E-TEBLİGAT Bilgilendirme === "
        .Body = ""
        For e = 1 To n
            .Attachments.Add dizi(e)
        Next e
        .Save
        .Display
 [B][COLOR="Red"]       .Send[/COLOR][/B]
    End With
    
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
Yukarıdaki şekilde işlem yaparak dener misiniz?
 
Son düzenleme:
Ömer Bey Tekrar Merhaba,
Dediğiniz gibi Call mail yerine Call kod olarak değiştirmiştim zaten.
Son dediklerinizin 2 değişikliği de aynen uyguladım. Hatasız çalıştı ve sorun yok.

Sadece bir öncesinde GÖNDERİLECEK MAIL EKRANI önüme gelip ben kontrol edip ondan sonra mail gönderiyordum.

Şimdi ise direkt gönderiyor. Bu da iyi ama Gönderim EKRANI gelsin kontrol edeyim sonra GÖNDER diyebileyim. Çünkü mail ekleri bazen fazla, kontrol edilmesi gerekir.

Saygı ve hürmetlerle,
 
Uzun kod'un sonlarına doğru
Kod:
With xlMail
.....
[B][COLOR="Red"].Send[/COLOR][/B]
....
End With
şeklindeki bölümde yer alan (yukarıdaki cevapta kırmızı renklendirdim),
satırın sol başına TEK TIRNAK ekleyin.
 
Merhaba,

'.Send kodun önüne tırnak koyup pasifleştirdim. Mail gönder ekranı geldi.

Ama çift tıkladığımda ilk işaretli mail önüme geliyor. İki önceki mailde 2 mail penceresi geliyordu.

Ömer bey hakkınızı helal edin. Sizi bu saatlerde çok yordum.
Tekrar teşekkür eder saygılar sunarım.

Ahmet Üçüncü
 
Ben şöyle düşünmüştüm.
Firma adına çift tıklama öncesinde o firmaya ait e-posta adreslerinin birine veya ikisine de X işareti eklenmiş durumda.
Dolayısıyla e-posta aynı firmaya ait iki adrese gönderiliyor.
Bu durumda 2 e-posta yerine, iki adrese gönderilen tek e-posta daha anlamlı olacak diye düşünmüştüm.

Ayrıca; sanırım meslek mensubusunuz.

Umarım mükelleflerinizin e-tebligat bildirimlerinde kendi e-posta adresinizi kullanmamışsınızdır (kullanmışsanız da bu bildirimlere ilişkin olarak bildirim sonrasında değişiklik yapmak mümkün).
Bunun ileride hukuki sonuçları olacaktır, daha sonra bir sıkıntıya girmemeniz için uyarmak istedim. Bildirimlerde mükelleferin kendilerine ait (kullandıkları-kontrol ettikleri) e-posta adreslerini kullanmalısınız.

Dilerseniz aşağıda verdiğim bağlantı üzerinden erişebileceğiniz İSMMMO duyurusuna bir göz atın.

E-Tebligat / Meslek Mensuplarının Sorumluluğu
 
Merhaba,

Evet dediğiniz gibi, iki adrese gönderilen tek e-posta daha anlamlı olacak. Sonradan fark ettim ki Mail gönderme yerinde 2 adet adres var fark etmemiştim. İlk arzum buydu. Tam dediğiniz gibi oldu ellerinize sağlık.

Mali müşavirlik yapıyorum Ömer Bey. Makrolar konusunda yeterince bilgim yok. Sizin yardımlarınızla geliştirmeye çalışıyorum.

Ayrıca uyarınız için de teşekkür ederim. Burada geçen mail adresleri tamamen gelişigüzeldir. Karşılıkları yoktur. Tebligat konusunda da benim mail adresini de elbette kullanmıyorum. Dediğiniz gibi yasal sakıncaları vardır. Uyarınız için teşekkürler.

Sanırım sizde bu yönde mesleki bilginiz sayesinde uyarıda bulundunuz. Çok memnun oldum.
Umarım bir gün görüşebiliriz.

Saygı ve esenlikler dilerim.
 
Son düzenleme:
Geri
Üst