DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhabalar, elimde bir excel dosyası var, üst bilgi kısmında sağ tarafta hizalama çalışmıyor galiba. Ekli resimde göstermeye çalıştım, sağ tarafa eklediğim metni hizalamak istiyorum, bunun bir yolu var mı?
Örnek bir dosya ekleyebilirseniz daha hızlı dönüş alırsınız...
Sub hizalı()
Set shp = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0)
shp.Select
Selection.ShapeRange.Line.Visible = msoFalse
With shp.TextFrame
.AutoSize = True
.Characters.Text = ActiveSheet.PageSetup.RightHeader
.MarginLeft = 0
.MarginRight = 0
.MarginTop = 0
End With
dosyaYolu = ThisWorkbook.Path & "\res.jpg"
shp.Copy
Set chObj = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=shp.Width, Height:=shp.Height)
chObj.ShapeRange.Line.Visible = msoFalse
With chObj
.Select
.Chart.Paste
.Chart.Export Filename:=dosyaYolu, FilterName:="JPG"
End With
ActiveSheet.PageSetup.RightHeaderPicture.Filename = dosyaYolu
chObj.Delete
shp.Delete
ActiveSheet.PageSetup.RightHeader = "&G"
Kill dosyaYolu
End Sub
Örnek kodda F11 hücresini kullandım, siz istediğiniz hücre/hücreleri kullanabilirsiniz.
F11 hücresine yazdığınız metni, resim olarak sağ üstbilgiye yapıştırır.
Kod:Sub hizalı() ActiveSheet.Range("F11").Copy ActiveSheet.Pictures.Paste.Select ad = Selection.Name Set shp = ActiveSheet.Shapes(ad) dosyaYolu = ThisWorkbook.Path & "\res.jpg" shp.Copy Set chObj = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=shp.Width, Height:=shp.Height) With chObj .Select .Chart.Paste .Chart.Export Filename:=dosyaYolu, FilterName:="JPG" End With chObj.Delete shp.Delete ActiveSheet.Range("F11").ClearContents ActiveSheet.PageSetup.RightHeaderPicture.Filename = dosyaYolu ActiveSheet.PageSetup.RightHeader = "&G" Kill dosyaYolu End Sub
Bahsettiğim makro uygulaması ektedir.
Logo yerine farklı br resim kullandım. Siz kendi logonuzu ilgili bölüme yapıştırıp güncellersiniz.
yukarıda önerdiğim kodu güncelledim