- Katılım
- 18 Kasım 2020
- Mesajlar
- 71
- Excel Vers. ve Dili
- İngilizce / office 2016
- Altın Üyelik Bitiş Tarihi
- 01-12-2023
Merhaba arkadaşlar,
Elimde bir makro var. Bu makro bir sayfanın benim belirlediğim alanını kopyalayıp mail atmak için hazırlıyor. Herşey iyi hoş ama belirlenen alan mail gönderme alanının içine yapıştığında biraz büyük ve kaba duruyor. Mail ortamında müdahale edebiliyorum ama müdahale etmeme gerek kalmadan nasıl orantılı şekilde ufaltabilirim ? Aşağıda paylaştığım kodlardaki "8"i küçültüp büyülttüğümde sağa sola uzama mesafesini etkiliyor ama aşağı yukarı yüksekliğini ayarlayan sayıyı bulamadım yada eklemem mi gerekir bilmiyorum. Eğer biliyorsanız yardımlarınız için şimdiden teşekkürler.
Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' Copy the range and create a workbook to receive the data.
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8 --------- BAHSİ GEÇEN 8 SAĞA SOLA UZAMAYI AYARLIYOR.
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
' Publish the sheet to an .htm file.
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
' Read all data from the .htm file into the RangetoHTML subroutine.
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center xublishsource=", _
"align=left xublishsource=")
' Close TempWB.
TempWB.Close savechanges:=False
' Delete the htm file.
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Elimde bir makro var. Bu makro bir sayfanın benim belirlediğim alanını kopyalayıp mail atmak için hazırlıyor. Herşey iyi hoş ama belirlenen alan mail gönderme alanının içine yapıştığında biraz büyük ve kaba duruyor. Mail ortamında müdahale edebiliyorum ama müdahale etmeme gerek kalmadan nasıl orantılı şekilde ufaltabilirim ? Aşağıda paylaştığım kodlardaki "8"i küçültüp büyülttüğümde sağa sola uzama mesafesini etkiliyor ama aşağı yukarı yüksekliğini ayarlayan sayıyı bulamadım yada eklemem mi gerekir bilmiyorum. Eğer biliyorsanız yardımlarınız için şimdiden teşekkürler.
Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' Copy the range and create a workbook to receive the data.
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8 --------- BAHSİ GEÇEN 8 SAĞA SOLA UZAMAYI AYARLIYOR.
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
' Publish the sheet to an .htm file.
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
' Read all data from the .htm file into the RangetoHTML subroutine.
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center xublishsource=", _
"align=left xublishsource=")
' Close TempWB.
TempWB.Close savechanges:=False
' Delete the htm file.
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function