Sadece belli hücrelerdeki resimleri silmek için makro

Hoksisamuray1

Enes Kolbaş
Katılım
30 Mayıs 2012
Mesajlar
31
Excel Vers. ve Dili
Office 365
Dosya-Seçenekler menüsünde KAYDET bölümü var. Oraya tıkladığınızda kurtarma yolu tanımlıdır. O klasöre ulaşıp kontrol edebilirsiniz.

Not : Profilinizde 2005 Office kullandığınız yazıyor. Gerçekten böyle bir sürüm var mı? Yoksa güncellemeniz size verilecek cevaplarda fayda sağlayacaktır.
Yok ustad ben ofis 365 kullanıyorum.. Ben aslında word dosyası uzerınden calısıyordum. Arad kaydedıyordum sılıyordum. Ama bır wındows guncellemesı sonrası baktım moduller gorunmuyor. Tekrar sımdı olusturuyorum. Ama kaydettıgımde ucarmı dıye tereddutteyım. Excelde boyle bırsey olmadı.

Birde ustad sımdı senın son kodunu kullandım. Logoyu ekleyecegım alan logo sıgmadıgı ıcın ılıgılı alanda enter yapılması gerekıyor. Bırde benım ılk ekleyecegım logoyu dırek ekleyıp ıkıncısı ıcın secmelı olsun ıstıyorum. Bunları eklı sorguya eklemen mumkun mu?

Sub Insert_Picture()
Dim My_File_Browser As FileDialog, My_File As String

Set My_File_Browser = Application.FileDialog(msoFileDialogFilePicker)

With My_File_Browser
.Title = "Lütfen Eklemek İstediğiniz Resim Dosyasını Seçiniz..."
.Filters.Clear
.Filters.Add "Resim Dosyaları", "*.jpg;*.jpeg;*.png;*.gif"
.InitialFileName = "C:\"
If .Show = -1 Then
My_File = .SelectedItems(1)
End If
End With

If My_File <> "" Then
ActiveDocument.Shapes.AddPicture _
FileName:=My_File, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=330, Top:=350, Width:=135, Height:=32
End If
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,579
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki bilgiyi profilinizde güncellemenizi rica ederim.

Yok ustad ben ofis 365 kullanıyorum..
Benim önerdiğim kodu sizin kod bloğunuzdaki aşağıdaki kalın fontlu satırın üstüne eklemeniz yeterli olacaktır.

Else
'MsgBox "zaten eklenmiş"

Eklemeyi yaparken benim önerimdeki makro adını ve End Sub bitiş satırını almadan eklemelisiniz.
 

Hoksisamuray1

Enes Kolbaş
Katılım
30 Mayıs 2012
Mesajlar
31
Excel Vers. ve Dili
Office 365
Aşağıdaki bilgiyi profilinizde güncellemenizi rica ederim.



Benim önerdiğim kodu sizin kod bloğunuzdaki aşağıdaki kalın fontlu satırın üstüne eklemeniz yeterli olacaktır.

Else
'MsgBox "zaten eklenmiş"

Eklemeyi yaparken benim önerimdeki makro adını ve End Sub bitiş satırını almadan eklemelisiniz.

üstad eline sağlık. Oldu. fakar logonun oldugu yerde enter yapıp yukarıdaki bilgiyle logonun oldugu alanda yer açmak istiyorum Bunu nasıl yapabilirim. Birde macrolarımı hepsini tek bir komutla çalıştırmak için ekli kodu açılıs dosyasına ekleyerek çalıştırıyorum olmuyor. Bu dosya seçilmesi muhabbetinden önce oluyordu. Bunu nasıl aşabilirim?

Sub auto_open()
Call Logo_Delete
Call replaceSampleToNothing
Call Logo_Duzenleme
Call Insert_Picture
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,579
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Logonun üstündeki boş bir satırdayken ENTER yaparak deneyiniz. Böyle boş alan ekleyebiliyor olmanız gerekir.

Belki makroların sırasını değiştirerek makroların tek seferde sorunsuz çalışmasını sağlayabilirsiniz.

Önerilerim çözüm olmazsa lütfen örnek dosyanızı paylaşınız.
 

Hoksisamuray1

Enes Kolbaş
Katılım
30 Mayıs 2012
Mesajlar
31
Excel Vers. ve Dili
Office 365
Logonun üstündeki boş bir satırdayken ENTER yaparak deneyiniz. Böyle boş alan ekleyebiliyor olmanız gerekir.

Belki makroların sırasını değiştirerek makroların tek seferde sorunsuz çalışmasını sağlayabilirsiniz.

Önerilerim çözüm olmazsa lütfen örnek dosyanızı paylaşınız.
Üstad denedim ama sıralamadan dolayıda olmadı. Birde sen bakabilirsen sevinirim. İki dosya var biri oncesi diğeri sonrasında olmasını istediğim. Birde Logunun üstüneki bilgiler ile arasında 1 satır boşluk olması gerekiyor. Onada bakabilirsen sevinirim.

Çalışma Dosyam
 

Hoksisamuray1

Enes Kolbaş
Katılım
30 Mayıs 2012
Mesajlar
31
Excel Vers. ve Dili
Office 365
Logonun üstündeki boş bir satırdayken ENTER yaparak deneyiniz. Böyle boş alan ekleyebiliyor olmanız gerekir.

Belki makroların sırasını değiştirerek makroların tek seferde sorunsuz çalışmasını sağlayabilirsiniz.

Önerilerim çözüm olmazsa lütfen örnek dosyanızı paylaşınız.
Merhaba Ustad kolay gelsin. Bakabıldın mı?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,579
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Logoyu ve sayfanın altındaki resmi dışardan alacak şekilde dosyanızı düzenledim. Eğer resimleri word dosyasıyla aynı klasör içinde tutma şansınız varsa dosya seçme işlemi iptal edilebilir.

Harici Link (Silinebilir) ; https://s6.dosya.tc/server13/q0v62d/Draft.rar.html
 

Ekli dosyalar

Hoksisamuray1

Enes Kolbaş
Katılım
30 Mayıs 2012
Mesajlar
31
Excel Vers. ve Dili
Office 365
Logoyu ve sayfanın altındaki resmi dışardan alacak şekilde dosyanızı düzenledim. Eğer resimleri word dosyasıyla aynı klasör içinde tutma şansınız varsa dosya seçme işlemi iptal edilebilir.

Harici Link (Silinebilir) ; https://s6.dosya.tc/server13/q0v62d/Draft.rar.html
Üstad eline sağlık güzel olmus. Resimleri aynı klasorde alıyorum. Zaten secmeli yapmamın sebebi sunum yapılacak olan magazanın farklı projeler olmasından dolayıdır. Bu yuzden secme opsıyonunu koymak ıstedım. Birde ustad aslında ıkıncı secılen logo aslında sabıt olaak onun ıcın sormasına erek yok. Sana gonderdıgım aslında kodu ona gore yapmıstık. Burada onu nasıl revıze edebılırız?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,579
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Hangi kodunuz aşağıdaki bölümü düzenliyor?
 

Hoksisamuray1

Enes Kolbaş
Katılım
30 Mayıs 2012
Mesajlar
31
Excel Vers. ve Dili
Office 365
Hangi kodunuz aşağıdaki bölümü düzenliyor?
üstad ekte ikinci resmi eklemek icin sordugu kısım secimsiz olarak eklenmeli

Set My_File_Browser = Application.FileDialog(msoFileDialogFilePicker)

With My_File_Browser
.Title = "Lütfen Eklemek İstediğiniz Resim Dosyasını Seçiniz..."
.Filters.Clear
.Filters.Add "Resim Dosyaları", "*.jpg;*.jpeg;*.png;*.gif"
.InitialFileName = "C:\"
If .Show = -1 Then
My_File = .SelectedItems(1)
End If
End With

If My_File <> "" Then
Selection.InlineShapes.AddPicture _
FileName:=My_File, _
LinkToFile:=False, SaveWithDocument:=True
End If
End If
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,579
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Resmin konumu nerde?
 

Korhan Ayhan

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

C++:
Option Explicit

Sub AutoOpen()
    Call Logo_Delete
    Call Insert_Picture
End Sub

Sub Insert_Picture()
    Dim My_File_Browser As FileDialog, My_File As String
    
    Set My_File_Browser = Application.FileDialog(msoFileDialogFilePicker)
    
    With My_File_Browser
        .Title = "Lütfen Eklemek İstediğiniz Resim Dosyasını Seçiniz..."
        .Filters.Clear
        .Filters.Add "Resim Dosyaları", "*.jpg;*.jpeg;*.png;*.gif"
        .InitialFileName = "C:\"
        If .Show = -1 Then
            My_File = .SelectedItems(1)
        End If
    End With
    
    If My_File <> "" Then
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "Google"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        Selection.MoveUp Unit:=wdLine, Count:=1
        
        Selection.InlineShapes.AddPicture _
        FileName:=My_File, LinkToFile:=False, SaveWithDocument:=True
        Selection.Collapse
        Selection.MoveDown Unit:=wdLine, Count:=2
        Selection.MoveUp Unit:=wdLine, Count:=1
        Selection.EndKey Unit:=wdLine
        Selection.TypeText vbCrLf & vbCrLf & vbCrLf
        
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "Bu rapor şirketimizin veritabanı, TUIK İstatistikleri ve Modelleme ekibimizin elde ettiği özel veri setlerini kullanılarak Lokasyon Analizi Modülü tarafından programatik olarak üretilmiştir."
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
        End With
        Selection.Find.Execute
        
        Selection.InlineShapes.AddPicture _
        FileName:="C:\pi\IsoLogo\NextGeoLogo.jpg", _
        LinkToFile:=False, SaveWithDocument:=True
    End If
End Sub

Sub Logo_Delete()
    Dim My_Picture As InlineShape, Count_Picture As Long

    For Each My_Picture In ActiveDocument.InlineShapes
        Count_Picture = Count_Picture + 1
        If Count_Picture = 2 Then My_Picture.Delete: Exit For
    Next
End Sub
 

Hoksisamuray1

Enes Kolbaş
Katılım
30 Mayıs 2012
Mesajlar
31
Excel Vers. ve Dili
Office 365
Deneyiniz.

C++:
Option Explicit

Sub AutoOpen()
    Call Logo_Delete
    Call Insert_Picture
End Sub

Sub Insert_Picture()
    Dim My_File_Browser As FileDialog, My_File As String
   
    Set My_File_Browser = Application.FileDialog(msoFileDialogFilePicker)
   
    With My_File_Browser
        .Title = "Lütfen Eklemek İstediğiniz Resim Dosyasını Seçiniz..."
        .Filters.Clear
        .Filters.Add "Resim Dosyaları", "*.jpg;*.jpeg;*.png;*.gif"
        .InitialFileName = "C:\"
        If .Show = -1 Then
            My_File = .SelectedItems(1)
        End If
    End With
   
    If My_File <> "" Then
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "Google"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        Selection.MoveUp Unit:=wdLine, Count:=1
       
        Selection.InlineShapes.AddPicture _
        FileName:=My_File, LinkToFile:=False, SaveWithDocument:=True
        Selection.Collapse
        Selection.MoveDown Unit:=wdLine, Count:=2
        Selection.MoveUp Unit:=wdLine, Count:=1
        Selection.EndKey Unit:=wdLine
        Selection.TypeText vbCrLf & vbCrLf & vbCrLf
       
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "Bu rapor şirketimizin veritabanı, TUIK İstatistikleri ve Modelleme ekibimizin elde ettiği özel veri setlerini kullanılarak Lokasyon Analizi Modülü tarafından programatik olarak üretilmiştir."
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
        End With
        Selection.Find.Execute
       
        Selection.InlineShapes.AddPicture _
        FileName:="C:\pi\IsoLogo\NextGeoLogo.jpg", _
        LinkToFile:=False, SaveWithDocument:=True
    End If
End Sub

Sub Logo_Delete()
    Dim My_Picture As InlineShape, Count_Picture As Long

    For Each My_Picture In ActiveDocument.InlineShapes
        Count_Picture = Count_Picture + 1
        If Count_Picture = 2 Then My_Picture.Delete: Exit For
    Next
End Sub

Üstad slm,

senide yorduk hakkını helal et. Şimdi kod dosyayı acarken çalışıyor. Ama tek sıkıntı rapor indiğinde dosyayı aç dediğimde Enable Editing uyarısı aldıgımdan kod burayı gecemedıgı ıcın hata verıyor. Bunu edit yaptıktan sonra tekrar open yaparam calısıyor. Bu Enable Editing'i otamatik onaylayan bir kod var mı? Birde bu olmazsa bu makroyu kısayol atayarak çalıştırabilir miyiz?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,579
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Linki inceleyiniz.

 

Hoksisamuray1

Enes Kolbaş
Katılım
30 Mayıs 2012
Mesajlar
31
Excel Vers. ve Dili
Office 365
Linki inceleyiniz.

Üstad bura baktım ama burası enable macroyla ilgili paylaşımlar var ama orada da saglıklı bir bilgi yok. Benim istedigim word açılışında ki Enable Editing i totomatik olarak gecmek. Ekte bir makro buldum ama uyarlayamadım. Ne yapacagımı çözemedim. Bir bakabilri misin? Ekte linki paylaştım.

Enable Editing
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,579
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ben aşağıdaki gibi uygulayınca dosya açılışında uyarı gelmedi.

Word'ü açtım.
Geliştirici sekmesinden Makro Güvenliği seçeneğine tıkladım.
Açılan pencerede aşağıdaki seçeneği seçip Word uygulamasını kapattım.

Sonra sizin dosyanızı açtım sorun olmadan açıldı.



244404
 

Hoksisamuray1

Enes Kolbaş
Katılım
30 Mayıs 2012
Mesajlar
31
Excel Vers. ve Dili
Office 365
Ben aşağıdaki gibi uygulayınca dosya açılışında uyarı gelmedi.

Word'ü açtım.
Geliştirici sekmesinden Makro Güvenliği seçeneğine tıkladım.
Açılan pencerede aşağıdaki seçeneği seçip Word uygulamasını kapattım.

Sonra sizin dosyanızı açtım sorun olmadan açıldı.


Üstad benim anlattıgım konu enable Mabro ile iglilşi değil. Onda zaten sıkıntı yok. Anlatmak istediğim Enable Editing. Ekte Screen paylaştım bakarsın. Bu dosya açılırken belgeyi düzenleme modunda açmak istiyor musun mubabbeti.

Enable Editing
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,579
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Paylaştığınız linkteki dosyayı oluşturdum.

Ekten indirebilirsiniz. Linkte bahsettiği gibi bu dosyayı aşağıdaki yola kopyalayın. Bu yola erişmek için GİZLİ klasörleri göster demeniz gerekebilir.

C:\Users\Kullanıcı_Adınız\AppData\Roaming\Microsoft\Word\STARTUP

Sonra wordu açtığınızda EKLENTİLER bölümünde bu şablonu görüyor olmanız gerekiyor.

Harici Link (Silinebilir) ; https://dosya.co/yaukys2rc3nv/Doc1.rar.html

Ben İngilizce sürüm kullandığım için dosya adı "Doc1" olarak görünüyor. Siz Türkçe sürüm kullanıyorsanız dosya adını "Belge1" olarak revize edebilirsiniz.
 

Ekli dosyalar

Üst