ÖRNEĞİN A HARFİ KAÇ DEFA GEÇTİ

A1=ARABULUCU

=SUMPRODUCT(LEN(A1)-LEN(SUBSTITUTE(A1;{“A”};””)))

SONUÇ:2

 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

——————————————–

   
       
            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;
}
       
   

   
       

 

   

——————————————-

  Not  enson birtane daha  button  koy arasına end koy tüm kodları durdurur…

once makro ozellikli excel dosyanı oluştur
sayfaya bir button yarat kaydet koy ismini

module 1
———————–
Sub kaydet()
Dim rng As Excel.Range
Set rng = Range(“A1:J19”)

If ExportRangeToPicture(rng, “C:\MSDS500\1\RAPORGUNLUKAYLIKTV\tv2.gif”) Then

Else

End If

If ExportRangeToPicture(rng, “\\DIGIKEY-PC\htmltvwebvesms\tv2.gif”) Then

Else

End If

ActiveWorkbook.RefreshAll
Application.OnTime Now + TimeValue(“00:00:30”), “kaydet”  ’10 saniyede bir kaydeder
End Sub
Sub durdur()
End
End Sub

———————–

module2
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
On Error Resume Next
rRng.CopyPicture xlScreen, xlPicture
On Error GoTo 0

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:30”), “SaveMyBook” ’10 saniyede bir kaydeder
End Sub

——————————-

html yarat

   
       
            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;
}