Yaz Makrosu

[alaybeyli]

Aktif sayfaya yaz butonu ekleyerek o sayfayı yazdırmak istiyorum. makro atamaya çalıştım beceremedim. yardımcı olabilecek arkadaşların yardımını bekliyorum.

 

[AS3434]

Sn. alaybeyli

Soru sormadan önce, lütfen forum içinde arama yapın.

Yukarıda ARAMA sekmesine tıklayın yazdır yazın . Çok farklı yazdır makroları mevcut.

 

[TAHİR ARSLAN]

Arkadaşım;
Ben bu siteye "Yaz makrosu" aramak için gelmiştim. Bulamadım. Size Yaz butonu ekleyerek istediğiniz sayfa nasıl yazdırılır yardımcı olayım. Şu adımları izlemelisiniz. Araçlar, Makro, Yeni Makro Kaydet. Makro adı : YAZ olsun. Kayıt başlayınca; Yazdıracağınız alanı bloklayınız. Dosya, Yazdırma alanını belirle adımlarını takip ederek, Baskı Önizleme ve sayfa ayarını yapıp Yazdır'dan yazıcı seçimini yaparak İptal etmelisiniz. Yazdırma makronuz hazır. Şimdi de Bu makroyu bir nesneye atamalısınız. Menülerin dışında bir yerde Sağ tıklayıp, Çizim'i etkin hale getiriniz. Excell Sayfasının altında dikdörtgen şekli var. Tıklayıp sayfanın herhangi bir yerine bu şekli çiziniz. (Veya sevdikleriniziin Resmini de yapıştırabilirsiniz.) Şekle Metin ekleyiniz (YAZDIR olabilir) Sonra şekle sağ tıklayıp Makro Atayınız. Karşınıza makrolarınız gelecek. YAZ makrosunu seçip atayınız. Şimdi bu şeklin üzerine geldiğinizde bir el belirecek. Şekle bastığınızda da Blokladığınız, Seçtiğiniz yazdırma alanını yazıcınıza gönderecektir. İyi Çalışmalar dilerim. T/A

 

[TAHİR ARSLAN]

Arkadaşlar;
Ben bu siteye Rakamı Metne çevirebilecek bir "Yaz makrosu" aramak için gelmiştim. Bulamadım.
Ancak bendeki bir makroyu paylaşmak istiyorum sizlerle. [Formul =yaz(A1), A1 hücresindeki Rakamı Formülün yazıldığı hücreye Metin olarak çevirir.]
Güle güle kullanınız.

Sub Makro1()
'
' Makro1 Makro
' Makro TAHİR ARSLAN tarafından 2005/12/29 tarihinde kaydedildi.
'

'
End Sub
Function yaz$(sayi)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)

b$(0) = ""
b$(1) = "Bir"
b$(2) = "İki"
b$(3) = "Üç"
b$(4) = "Dört"
b$(5) = "Beş"
b$(6) = "Altı"
b$(7) = "Yedi"
b$(8) = "Sekiz"
b$(9) = "Dokuz"

y$(0) = ""
y$(1) = "On"
y$(2) = "Yirmi"
y$(3) = "Otuz"
y$(4) = "Kırk"
y$(5) = "Elli"
y$(6) = "Altmış"
y$(7) = "Yetmiş"
y$(8) = "Seksen"
y$(9) = "Doksan"

m$(0) = "Trilyon"
m$(1) = "Milyar"
m$(2) = "Milyon"
m$(3) = "Bin"
m$(4) = ""

a$ = Str(sayi)

If Left$(a$, 1) = " " Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For x = 1 To Len(a$)
If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) < Asc("0")) Then GoTo hata
Next x

If Len(a$) > 15 Then GoTo hata
a$ = String(15 - Len(a$), "0") + a$

For x = 1 To 15
v(x) = Val(Mid$(a$, x, 1))
Next x

s$ = ""
For x = 0 To 4
c(1) = v((x * 3) + 1)
c(2) = v((x * 3) + 2)
c(3) = v((x * 3) + 3)
If c(1) = 0 Then
e$ = ""
ElseIf c(1) = 1 Then
e$ = "Y&#252;z"
Else
e$ = b$(c(1)) + "Y&#252;z"
End If
e$ = e$ + y$(c(2)) + b$(c(3))
If e$ <> "" Then e$ = e$ + m$(x)
If (x = 3) And (e$ = "BirBin") Then e$ = "Bin"
s$ = s$ + e$
Next x

If s$ = "" Then s$ = "S&#305;f&#305;r"
If pozitif = 0 Then s$ = "Eksi" + s$

yaz$ = s$
GoTo tamam
hata: yaz$ = "Hata"
tamam:
End Function

 

[Ferhat Pazarçevirdi]

Tahir bey, &#246;rne&#287;iniz i&#231;in te&#351;ekk&#252;rler ...

Ancak, arama kutucu&#287;una "rakam&#305; yaz&#305;ya" veya "say&#305;y&#305; yaz&#305;ya" kelimelerini yazarak aramay&#305; denediniz mi hi&#231; ? ...

 

[kelkitli]

Selamlar, &#304;nceleyiniz.
http://www.excel.web.tr/showthread.php?t=12077&highlight=YTL+&#37;E7evir