hücre birleştirip ok çizdiren makro

udentr2002

Altın Üye
Katılım
5 Kasım 2006
Mesajlar
1,503
Excel Vers. ve Dili
iş yerinde Office 365
evde Office 365
Altın Üyelik Bitiş Tarihi
25-12-2029
merhaba sayın hocalarım bunu diğer sayfada yanlış bir yerde yanlış bir şekilde sorunca farklı cevaplar aldım bu yüzden makro ile ilgili bir şey olduğu için burda da sormak istedim ekli dosyayı incelerseniz anlatmaya çalıştım sadece istediğim seçli olan bir hücrede ekli dosyada gösterilen gibi hücre birleştirip yanına ok çizdirmek isitiyorum bunu makro ile yapıp bir düğmeye atamak ve her lazım olduğunda da kullanmak isitiyorum yardımcı olursanız şimdiden çok sevinirim Allah'a emanet olun saygılarımla
 

udentr2002

Altın Üye
Katılım
5 Kasım 2006
Mesajlar
1,503
Excel Vers. ve Dili
iş yerinde Office 365
evde Office 365
Altın Üyelik Bitiş Tarihi
25-12-2029
sayın hocalarım

bilen yokmu lütfen yardımcı olursanız çok sevineceğim lütfen
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,058
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Epeyce uğraştırdı ama sanıyorum istediğiniz gibi oldu.

Kod:
Sub akım()
Dim s(2)
Set s(1) = Range(ActiveCell, ActiveCell.Offset(3, 2))
Set s(2) = Range(ActiveCell.Offset(0, 5), ActiveCell.Offset(3, 7))
For a = 1 To 2
s(a).Merge
s(a).Borders(xlEdgeLeft).LineStyle = xlContinuous
s(a).Borders(xlEdgeLeft).Weight = xlMedium
s(a).Borders(xlEdgeTop).LineStyle = xlContinuous
s(a).Borders(xlEdgeTop).Weight = xlMedium
s(a).Borders(xlEdgeBottom).LineStyle = xlContinuous
s(a).Borders(xlEdgeBottom).Weight = xlMedium
s(a).Borders(xlEdgeRight).LineStyle = xlContinuous
s(a).Borders(xlEdgeRight).Weight = xlMedium
Next
yat1 = s(2).Left - (ActiveCell.Offset(0, 1).Width + ActiveCell.Offset(0, 2).Width)
yat2 = ActiveCell.Top + ActiveCell.Height * 2
yat3 = s(2).Left
yat4 = ActiveCell.Top + ActiveCell.Height * 2
ActiveSheet.Shapes.AddLine(yat1, yat2, yat3, yat4).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
dik1 = ActiveCell.Offset(0, 4).Left + ActiveCell.Offset(0, 4).Width / 2
dik2 = ActiveCell.Offset(1, 4).Top
dik3 = ActiveCell.Offset(0, 4).Left + ActiveCell.Offset(0, 4).Width / 2
dik4 = ActiveCell.Offset(1, 4).Top + ActiveCell.Offset(2, 4).Height + ActiveCell.Offset(1, 4).Height
ActiveSheet.Shapes.AddLine(dik1, dik2, dik3, dik4).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
ActiveCell.Select
End Sub
 

udentr2002

Altın Üye
Katılım
5 Kasım 2006
Mesajlar
1,503
Excel Vers. ve Dili
iş yerinde Office 365
evde Office 365
Altın Üyelik Bitiş Tarihi
25-12-2029
Hocam Her Zamankİ Gİbİ Harİkasin

ne diyeyim valla çok uğraşmışsınız belli Allah razı olsun emeğinize canınıza elinize sağlık sizi yordum özür dilerim hakkınızı helal edin. Ama ben basit bir şeydir diye düşndüm baya bi karışıkmış benim kullandığım buna benzer şekiller var ama ben sizden bunu öğrenip diğerlerinide kendim uyarlarım diye düşnmüştüm şimdi kodu inceleyince bunu yapabilmem imkansız. Bu yüzden sizden tekrar özür dileyerek ekli dosya ile göndereceğim şeklinde kodunu söyleyebilrmisiniz inanın çok makbule geçer. OnA benzer bir şey buda ama sadece tek hücre birleştirmesi var. Ekli dsyada anlattım hocam bakarsan makbule geçer
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,058
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Excel üzerindeki resimleri koordinatlara göre gezdirmek kolay değildir. Birde hücre boyutları değiştiğinde araya konacak oklarında buna göre ayarlanması gerekir ki işte kodu karıştıranda budur. Siz kullandığınız tüm şekilleri bir dosyada toplayıp ekleyin, ben müsait oldukça üzerinde çalışırım. Şekil1 karşısında şekli, şekil2 karşısında şekli gibi.
 
Üst