excel live sheet 3 . gif olarak kaydeder
Not dosya c :\ range . gif her 10 saniyede kaydedecek .
ilk önce excelde
developer -> insert -> Button
buttonun ismini kaydet ve recorda bas ve ok bas ve a1e tıkla stop recording bas ve f11e bas aşağısı gibi yap. ( developer mode yoksa excel toolbara sağ tıklas-> customise the ribbona bas developeri seç ve sağa koy...)
Sub kaydet ()
Dim rng As Excel . Range
Set rng = Range ("A1:D38")
If ExportRangeToPicture(rng, " C :\ range . gif ") Then
Else
End If
ActiveWorkbook.RefreshAll
Application.OnTime Now + TimeValue("00:0: 10 "), " kaydet " ' 10 saniyede bir kaydeder
End Sub
ve daha sonra microsof excel objectse tıkla ve insert module bas ve içine aşağıdakileri yapıştır
Function ExportRangeToPicture(rng As Excel . Range , img As String) As Boolean
' save a range from Excel as a picture
' rng = Range to export
' img = filename & path
' basic error checking
' check for valid filetypes
' from http://peltiertech.com/WordPress/export-chart-as-image-file/
Const FILE_EXT As String = " gif ,png,jpg,jpe,jpeg"
If InStr(FILE_EXT, LCase$(Right$(img, 3))) = 0 Then
GoTo ExitProc
End If
' check for valid path
Dim path As String
path = Left$(img, InStrRev(img, "\"))
If Dir(path, vbDirectory) = "" Then GoTo ExitProc
' check for valid range
Dim rRng As Excel . Range
On Error Resume Next
Set rRng = rng.CurrentRegion
On Error GoTo 0
If rRng Is Nothing Then GoTo ExitProc
' check for protected worksheet
If ActiveSheet.ProtectContents Then GoTo ExitProc
' copy range to picture, put into chart, export it
Application.ScreenUpdating = False
rRng.CopyPicture xlScreen, xlPicture
Dim cht As Excel .ChartObject
Set cht = ActiveSheet.ChartObjects.Add(0, 0, rng.Width + 10 , rng.Height + 10 )
With cht
.Chart.Paste
.Chart.Export img
.Delete
End With
' if we got this far, assume success
ExportRangeToPicture = True
ExitProc:
Application.ScreenUpdating = True
Set cht = Nothing
Set rRng = Nothing
End Function
Sub SaveMyBook()
'Turn off Excel message alerts
Application.DisplayAlerts = False
'Save this workbook.
ThisWorkbook.Save
'Turn back on alerts
Application.DisplayAlerts = True
'call this procedure again in another 15 mins
Application.OnTime Now + TimeValue("00:00: 10 "), "SaveMyBook" ' 10 saniyede bir kaydeder
End Sub
--------------------------------------------
<html>
<meta http-equiv="refresh" content="20" >
<head>
<style type="text/css">
body
{
margin: 0;
overflow: hidden;
}
#iframe1
{
height: 100%;
left: 0px;
position: absolute;
top: 0px;
width: 100%;
}
.image{
float:left;
margin-top:250px;
padding:12px;
width:200px;
}
</style>
</head>
<body>
<iframe id="iframe1" src="tv2. gif " frameborder="0">
</iframe>
<br><br><br><br><br><br><br><br><br><br><br>
<p align="center">
<img src="EARTHSPINING. gif " align="middle" height=50%" width=30%>
</p>
</body>
-------------------------------------------
Not enson birtane daha button koy arasına end koy tüm kodları durdurur...
Not dosya c :\ range . gif her 10 saniyede kaydedecek .
ilk önce excelde
developer -> insert -> Button
buttonun ismini kaydet ve recorda bas ve ok bas ve a1e tıkla stop recording bas ve f11e bas aşağısı gibi yap. ( developer mode yoksa excel toolbara sağ tıklas-> customise the ribbona bas developeri seç ve sağa koy...)
Sub kaydet ()
Dim rng As Excel . Range
Set rng = Range ("A1:D38")
If ExportRangeToPicture(rng, " C :\ range . gif ") Then
Else
End If
ActiveWorkbook.RefreshAll
Application.OnTime Now + TimeValue("00:0: 10 "), " kaydet " ' 10 saniyede bir kaydeder
End Sub
ve daha sonra microsof excel objectse tıkla ve insert module bas ve içine aşağıdakileri yapıştır
Function ExportRangeToPicture(rng As Excel . Range , img As String) As Boolean
' save a range from Excel as a picture
' rng = Range to export
' img = filename & path
' basic error checking
' check for valid filetypes
' from http://peltiertech.com/WordPress/export-chart-as-image-file/
Const FILE_EXT As String = " gif ,png,jpg,jpe,jpeg"
If InStr(FILE_EXT, LCase$(Right$(img, 3))) = 0 Then
GoTo ExitProc
End If
' check for valid path
Dim path As String
path = Left$(img, InStrRev(img, "\"))
If Dir(path, vbDirectory) = "" Then GoTo ExitProc
' check for valid range
Dim rRng As Excel . Range
On Error Resume Next
Set rRng = rng.CurrentRegion
On Error GoTo 0
If rRng Is Nothing Then GoTo ExitProc
' check for protected worksheet
If ActiveSheet.ProtectContents Then GoTo ExitProc
' copy range to picture, put into chart, export it
Application.ScreenUpdating = False
rRng.CopyPicture xlScreen, xlPicture
Dim cht As Excel .ChartObject
Set cht = ActiveSheet.ChartObjects.Add(0, 0, rng.Width + 10 , rng.Height + 10 )
With cht
.Chart.Paste
.Chart.Export img
.Delete
End With
' if we got this far, assume success
ExportRangeToPicture = True
ExitProc:
Application.ScreenUpdating = True
Set cht = Nothing
Set rRng = Nothing
End Function
Sub SaveMyBook()
'Turn off Excel message alerts
Application.DisplayAlerts = False
'Save this workbook.
ThisWorkbook.Save
'Turn back on alerts
Application.DisplayAlerts = True
'call this procedure again in another 15 mins
Application.OnTime Now + TimeValue("00:00: 10 "), "SaveMyBook" ' 10 saniyede bir kaydeder
End Sub
--------------------------------------------
<html>
<meta http-equiv="refresh" content="20" >
<head>
<style type="text/css">
body
{
margin: 0;
overflow: hidden;
}
#iframe1
{
height: 100%;
left: 0px;
position: absolute;
top: 0px;
width: 100%;
}
.image{
float:left;
margin-top:250px;
padding:12px;
width:200px;
}
</style>
</head>
<body>
<iframe id="iframe1" src="tv2. gif " frameborder="0">
</iframe>
<br><br><br><br><br><br><br><br><br><br><br>
<p align="center">
<img src="EARTHSPINING. gif " align="middle" height=50%" width=30%>
</p>
</body>
-------------------------------------------
Not enson birtane daha button koy arasına end koy tüm kodları durdurur...
