Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 02-03-2011, 08:17   #1
Büşra Güzelyurt
 
Giriş: 03/08/2010
Şehir: İstanbul
Mesaj: 57
Excel Vers. ve Dili:
2007 Türkçe
Exclamation Başka yerdeki hücreyi boyayabilmem mümkün mü aynı sayfada ?

Merhaba,

Aslında ben bu konuyu açmıştım fakat yapılan cevaplardan arkaplanda kaldı yeninden konu açma gereği duydum.

projemde kodlar çalışıyor ve seçime göre sistem şeklilleri geliyor fakat ben başka bir aralıkta resim getirmek yada kolaysa boyamak istiyorum. Ne yapmam lazım bu kodun neresine ne eklmem lazım acaba ?

yardımınız için şimdiden teşekkürler....

Kodlar bunlar fakat bunun neresine eklenti yapmam lazım ?

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.CommandBars("Picture").Visible = False
If Intersect(Target, Range("C11:C" & [c65536].End(3).Row)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.CommandBars("Picture").Visible = False
 ActiveSheet.DrawingObjects.Delete
For U = 11 To Range("C65536").End(3).Row
    If Cells(U, "C") <> "" Then
        Resim = Left(Cells(U, "C"), 5) & " Resmi"
        Sheets("Geviss").Select
        ActiveSheet.Shapes("" & Resim & "").Select
    With Selection
        .ShapeRange.LockAspectRatio = msoTrue
        .ShapeRange.Height = 14#
        .ShapeRange.Width = 20#
        .ShapeRange.Rotation = 0#
        .ShapeRange.LockAspectRatio = msoTrue
        .ShapeRange.Height = 17.75
        .ShapeRange.Width = 22.5
        .ShapeRange.Rotation = 0#
            
            Sheets("Geviss").Shapes("" & Resim & "").Copy
            Sheets("Veri Girişi").Select
            Cells(U, "B").Select
            ActiveSheet.Paste
        
        Sheets("Geviss").Select
        .ShapeRange.LockAspectRatio = msoTrue
        .ShapeRange.Height = 14#
        .ShapeRange.Width = 20#
        .ShapeRange.Rotation = 0#
        Sheets("Veri Girişi").Select
    End With
    End If
Next
Cells(Target.Row, "C").Select
Application.ScreenUpdating = True
End Sub
Eklenmiş Dosyalar
Dosya Türü: rar Test.rar (30.9 KB, 10 Görüntülenme)
Büşra Güzelyurt Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-03-2011, 09:26   #2
Huseyinkis
 
Huseyinkis kullanıcısının avatarı
 
Giriş: 23/09/2004
Şehir: İstanbul
Mesaj: 1,748
Excel Vers. ve Dili:
Excel 2010 TR
Varsayılan

Ekteki dosyayı incelermisiniz.
Eklenmiş Dosyalar
Dosya Türü: rar Test.rar (38.3 KB, 17 Görüntülenme)
__________________
///Ya severek "Acı Çekmesini" biliceksin yada Sevmeyeceksin hep "Acı Çekeceksin"///
Huseyinkis Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-03-2011, 12:55   #3
Büşra Güzelyurt
 
Giriş: 03/08/2010
Şehir: İstanbul
Mesaj: 57
Excel Vers. ve Dili:
2007 Türkçe
Varsayılan

Merhaba,

Çok teşekkürler fakat sadece beyaz renk geliyor, ben diğer renklerin gelmesi için nereye eklenti yapmam gerek ? İnanın bulamadım

Next
Cells(Target.Row, "C").Select
GoTo son:
Application.ScreenUpdating = True
BBB:
For a = 1 To Range("P65536").End(3).Row
If Range("F5").Value = Cells(a, "P").Value Then
renk = Cells(a, "Q").Interior.Color * 1
Range("E5").Interior.Color = renk
End If
Next a
son:

Burayamı yazmam gerek ? tekrardan çok teşekkür ederim...
Büşra Güzelyurt Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-03-2011, 13:09   #4
Huseyinkis
 
Huseyinkis kullanıcısının avatarı
 
Giriş: 23/09/2004
Şehir: İstanbul
Mesaj: 1,748
Excel Vers. ve Dili:
Excel 2010 TR
Varsayılan

P hücresine renkleri tanımlamışsınız bende Q hücresine p hücresinde seçilen renge hücre biçimini aynı renk yapın.

Mesala P2=Altınmeşe Q2= Hücre dolgu rengini Sarı yapın. Altınmeşe seçilinde E5 sarı olacaktır.
__________________
///Ya severek "Acı Çekmesini" biliceksin yada Sevmeyeceksin hep "Acı Çekeceksin"///
Huseyinkis Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-03-2011, 14:20   #5
Büşra Güzelyurt
 
Giriş: 03/08/2010
Şehir: İstanbul
Mesaj: 57
Excel Vers. ve Dili:
2007 Türkçe
Varsayılan

Bu beyaza boyuyor tamam ... Sarı renk için nereye kod yazıcam inanın bulamadım

Alıntı:
Next
Cells(Target.Row, "C").Select
GoTo son:
Application.ScreenUpdating = True
BBB:
For a = 1 To Range("P65536").End(3).Row
If Range("F5").Value = Cells(a, "P").Value Then
renk = Cells(a, "Q").Interior.Color * 1
Range("E5").Interior.Color = renk
End If
Next a
son:

Bu şekilde mi olması lazım o zamanda çalışmıyor hata veriyor.

Alıntı:
Next
Cells(Target.Row, "C").Select
GoTo son:
Application.ScreenUpdating = True
BBB:
For a = 1 To Range("P65536").End(3).Row
If Range("F5").Value = Cells(a, "P").Value Then
renk = Cells(a, "Q").Interior.Color * 1
Range("E5").Interior.Color = renk
End If
Next a

////// Burada bu kodu kopyalıyorum ama olmuyor
Next
Cells(Target.Row, "C").Select
GoTo son:
Application.ScreenUpdating = True
BBB:
For a = 1 To Range("P65536").End(3).Row
If Range("F5").Value = Cells(a, "P2").Value Then
renk = Cells(a, "Q2").Interior.Color * 1
Range("E5").Interior.Color = renk
End If
Next a

son:
Büşra Güzelyurt Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-03-2011, 14:38   #6
Huseyinkis
 
Huseyinkis kullanıcısının avatarı
 
Giriş: 23/09/2004
Şehir: İstanbul
Mesaj: 1,748
Excel Vers. ve Dili:
Excel 2010 TR
Varsayılan

Alıntı:
Büşra Güzelyurt tarafından gönderildi Mesajı Görüntüle
Bu beyaza boyuyor tamam ... Sarı renk için nereye kod yazıcam inanın bulamadım

Bu şekilde mi olması lazım o zamanda çalışmıyor hata veriyor.
Kodda bir değişiklik yapmıycaksınız benim yazdığım kodlar aynen kalsın. Siz "Veri Girişi" sayfasında Q1 Q2 Q3 Q4 hücrelerinin dolgı renklerini değiştirmeniz gerekiyor.
__________________
///Ya severek "Acı Çekmesini" biliceksin yada Sevmeyeceksin hep "Acı Çekeceksin"///
Huseyinkis Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-03-2011, 15:34   #7
Büşra Güzelyurt
 
Giriş: 03/08/2010
Şehir: İstanbul
Mesaj: 57
Excel Vers. ve Dili:
2007 Türkçe
Varsayılan

ayy çok pardon ben görmedim orayı ))...

Allah razı olsun çok çok sağolun Hüseyin bey ....
Büşra Güzelyurt Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-03-2011, 18:10   #8
Huseyinkis
 
Huseyinkis kullanıcısının avatarı
 
Giriş: 23/09/2004
Şehir: İstanbul
Mesaj: 1,748
Excel Vers. ve Dili:
Excel 2010 TR
Varsayılan

Alıntı:
Büşra Güzelyurt tarafından gönderildi Mesajı Görüntüle
ayy çok pardon ben görmedim orayı ))...

Allah razı olsun çok çok sağolun Hüseyin bey ....
Teşekkürler.

İyi Çalışmalar.
__________________
///Ya severek "Acı Çekmesini" biliceksin yada Sevmeyeceksin hep "Acı Çekeceksin"///
Huseyinkis Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 10:36


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil ve Konuşma Terapisti- Çorlu Dil ve Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Havuz- Makina- Danışmazlar-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden