• DİKKAT

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

metin kutusu ile buton arasında makro oluşturma

Y

yenibeyin

Katılım
7 Haziran 2011
Mesajlar
9
Excel Vers. ve Dili
vbasic
arkadaşlar fatura dosyası oluşturdum

yalnız bir yerde takıldım çözemedim

herhangi bir buton oluşturup tıkladığım zaman
sayfa içerisinde ne kadar metin kutusu varsa içeriğindeki yazıları silsin

"sayfayı temizle babında bişey"

örneğin



Sub Düğme1_Tıklat()

metinkutusu1.text = ""
metinkutusu2.text = ""
metinkutusu3.text = ""
metinkutusu4.text = ""

End Sub


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


ekte dosya mevcut
 

Ekli dosyalar

yenibeyin' Alıntı:
"sayfayı temizle babında bişey"

örneğin



Sub Düğme1_Tıklat()

metinkutusu1.text = ""
metinkutusu2.text = ""
metinkutusu3.text = ""
metinkutusu4.text = ""

End Sub




ekte dosya mevcut
Genişletmek için tıkla ...

sayın yenibeyin dosyanızı açamadım, ama sorunuza göre metin olan hücreler için
örneğim
A1:K30 hücreleri arası
B42 hücresinde metin var ise

Sub Düğme1_Tıklat()

[A1:K30]=""
[B42]=""
End Sub
şeklinde yaparak bu hücrelerdeki verileri silebilirsiniz.
 
Merhaba, 2 tane metin kutusu için hazırladım. Tablonuza göre kodları çoğaltın.

Kod: 
Sub temizle()
    Sheets("Sayfa1").Shapes("[COLOR="Red"]50 Metin kutusu[/COLOR]").delete
    Sheets("Sayfa1").Shapes("[COLOR="Red"]5 Metin kutusu[/COLOR]").delete

End Sub
 
Merhaba,
alternatif olsun.
Kod: 
Sub Düğme1_Tıklat()
     Dim s1 As Worksheet
     Set s1 = Sheets("Sayfa1")
     Dim shp As Shape
     For Each shp In s1.Shapes
        If InStr(1, shp.Name, "Metin", vbTextCompare) > 1 Then
           For i = 17 To 32
             If CStr(Mid(shp.Name, 1, 2)) = CStr(i) Then
              GoTo gec
              End If
            Next i
           shp.TextEffect.Text = ""
gec:
        End If
     Next shp
  Set s1 = Nothing
End Sub

Sadece 28 ve 29 no'lu metin kutusunu silip yerine yeni metin kutusu oluşturun. Tümünün içeriğini siler. İyi çalışmalar.
 
Kod: 
Sub metinkutususil()
ActiveSheet.DrawingObjects.Text = ""
End Sub
Şeklinde deneyiniz.
 
huseyincoban' Alıntı:
Merhaba, 2 tane metin kutusu için hazırladım. Tablonuza göre kodları çoğaltın.

Kod: 
Sub temizle()
    Sheets("Sayfa1").Shapes("[COLOR="Red"]50 Metin kutusu[/COLOR]").delete
    Sheets("Sayfa1").Shapes("[COLOR="Red"]5 Metin kutusu[/COLOR]").delete

End Sub
Genişletmek için tıkla ...


bu kod metin kutusunu komple siliyor ben yalnızca içindeki metni silsin istiyorum


dentex' Alıntı:
Merhaba,
alternatif olsun.
Kod: 
Sub Düğme1_Tıklat()
     Dim s1 As Worksheet
     Set s1 = Sheets("Sayfa1")
     Dim shp As Shape
     For Each shp In s1.Shapes
        If InStr(1, shp.Name, "Metin", vbTextCompare) > 1 Then
           For i = 17 To 32
             If CStr(Mid(shp.Name, 1, 2)) = CStr(i) Then
              GoTo gec
              End If
            Next i
           shp.TextEffect.Text = ""
gec:
        End If
     Next shp
  Set s1 = Nothing
End Sub

Sadece 28 ve 29 no'lu metin kutusunu silip yerine yeni metin kutusu oluşturun. Tümünün içeriğini siler. İyi çalışmalar.
Genişletmek için tıkla ...

sorun çalıştı bu kod çok teşekkürler kardeş ;)
 
Son düzenleme:
kardeş başını ağrıtıcam ama kusura bakma bi sorunum daha var

aynı dosya da "genel toplam" kısmını alt satırda bulunan "yalnız" metin kutusunun yanına rakamdan yazıya çevrilmiş olarak nasıl aktarabiliriz.

fonksiyon kısmını modul olarak ekledim

=Tlira (16 metinkutusu)

üstteki formül şeklinde düşünebilirsin

=Tlira(A1) -----bu şekilde yazınca formül çalışıyor...
 
Merhaba,
sorunu tam olarak anlayamadım. Dosyanızın son halini ve olmasını istediğiniz şeyleri yazıp eklerseniz yardımcı olabilirim. İyi çalışmalar.
 
örnek dosyada görülen

"16 metin kutusu" yani genel toplam kısmı içerisine girilen tutarı örneğin 16.000 tl

(yalnız diye başlayan kısma) "13 metin kutusu" içeriğine on altı bin tl şeklinde yazsın


dosya içerisinde module3 kısmında fonksiyon mevcut (rakamdan yazıya çeviriyor)

=Tlira(alan adı) şeklinde çalışıyor
 

Ekli dosyalar

Merhaba,
16 nol'lu metin kutusuna rakkam yazılınca makroyu tetikleyecek bir şey bulamadım. Ancak rakkam girdikten sonra metin kutusu kliklenince çalıştırdım.
Kod: 
Sub Mtinkutusu_Click()
If CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text) > 0 Then
ActiveSheet.Shapes("13 Metin Kutusu").TextEffect.Text = TLira(CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text))
End If
End Sub

bu kodu bir düğmeye de bağlayabilirsiniz.
 
dentex' Alıntı:
Merhaba,
16 nol'lu metin kutusuna rakkam yazılınca makroyu tetikleyecek bir şey bulamadım. Ancak rakkam girdikten sonra metin kutusu kliklenince çalıştırdım.
Kod: 
Sub Mtinkutusu_Click()
If CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text) > 0 Then
ActiveSheet.Shapes("13 Metin Kutusu").TextEffect.Text = TLira(CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text))
End If
End Sub

bu kodu bir düğmeye de bağlayabilirsiniz.
Genişletmek için tıkla ...

çok teşekkğr ederim

yalnız adlı metin kutusunu buton yapıp tıklayınca çalıştırdım işimi görür bu şekilde çok sağol




kardeş yine bişey denedim olmadı
Kod: 
Sub Düğme2_Tıklat()
If CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text) > 0 Then
MsgBox ("Genel Toplam Tutarı Girilmemiş")
GoTo bitir
Else
ActiveSheet.Shapes("13 Metin Kutusu").TextEffect.Text = TLira(CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text))

End If
bitir:
End Sub

"16 metin kutusu boş olduğu zaman
Kod: 
If CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text) > 0 Then
bu satır hata veriyor

bende vbasic te hatırladığım kadarıyla goto komutunu kullandım kabul etmiyor neden olabilir
 
Son düzenleme:
Merhaba,
bir üst satırına
Kod: 
If ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text="" or isnumeric(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text)[B][COLOR=Red]=[/COLOR][/B]false then exit sub
ekleyerek dener misiniz?
 
Son düzenleme:
Kod: 
Sub Düğme2_Tıklat()
If ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text="" or isnumeric(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text) false then exit sub
If CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text) > 0 Then
ActiveSheet.Shapes("13 Metin Kutusu").TextEffect.Text = TLira(CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text))
End If
End Sub

compile error:
syntax error


hatası verdi
 
Merhaba,
13 no'lu mesajdaki kırmızı ile işaretli "=" işaretini ekleyiniz. Sanırım eklemeyi unuttum, özür.
 
Merhaba,
son haliyle dosyayı ekler misiniz?
 
Merhaba,
şu dekilde değiştiriniz, iyi çalışmalar.

Kod: 
Sub Düğme2_Tıklat()
[COLOR=Red]If ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text = "" Then Exit Sub[/COLOR]
If CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text) > 0 Then
ActiveSheet.Shapes("13 Metin Kutusu").TextEffect.Text = TLira(CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text))
End If
End Sub
 
kardeş çok teşekkürler yardımların neticesinde belgem bişeye benzedi

ek olarak koda hata iletisi ekledim birisine lazım olur diye ekliyorum buraya

Kod: 
Sub Düğme2_Tıklat()
If ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text = "" Then GoTo haTa
If CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text) > 0 Then
ActiveSheet.Shapes("13 Metin Kutusu").TextEffect.Text = TLira(CDbl(ActiveSheet.Shapes("16 Metin Kutusu").TextEffect.Text))
End If
GoTo finisH
haTa:
MsgBox "Genel Toplam Tutarı Girilmemiş"
finisH:
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst