Self updating statistic widget

TriniMike · Post by **TriniMike** » October 30th, 2019, 9:26 pm

Hey everyone,

new to the forum but very interested in learning coding... Would anyone be able to link me to a tutorial on how to make a self updating widget using an excel source file?

for example I'd like to create a floating widget that has a simple statistic like "tomatoes sold" that would update as they are sold using an excel document as the source file and state something like "48/100 Tomatoes have been sold by team RED".

Any help would be appreciated!

mak_kawa · Post by **mak_kawa** » October 30th, 2019, 11:48 pm

Rainmeter can not handle Excel native (binary) data as far as I know, unless someone has made "Excel data plugin".

But, just an idea, when write the data from Excel as csv file, we can get such skin using Webparser measure. I will try to make... give me some time.

mak_kawa · Post by **mak_kawa** » October 31st, 2019, 12:04 am

Is this what you want? I am not sure, but...

Untitled-1.png

Code: Select all

[Rainmeter]
Update=1000
BackgroundMode=2
SolidColor=192,192,192,192

[Variables]
DataFile=D:\Rainmeter\Skins\test\Book1.csv
Item1=Tomato
Item2=Apple

[ReadData]
Measure=Webparser
URL=File://#DataFile#
RegExp=(?siU).*#Item1#,(.*),(.*)\r\n#Item2#,(.*),(.*)$
UpdateRate=10

[Item1Source]
Measure=Webparser
URL=[ReadData]
StringIndex=1

[Item1Sold]
Measure=Webparser
URL=[ReadData]
StringIndex=2

[Item1Stock]
Measure=Calc
Formula=Item1Source - Item1Sold
DynamicVariables=1

[Item2Source]
Measure=Webparser
URL=[ReadData]
StringIndex=3

[Item2Sold]
Measure=Webparser
URL=[ReadData]
StringIndex=4

[Item2Stock]
Measure=Calc
Formula=Item2Source - Item2Sold
DynamicVariables=1

[DisplayHeadline]
Meter=String
StringStyle=Bold
Text=Item     Source    Sold   Stock

[DisplayData]
Meter=String
Y=15r
MeasureName=Item1Source
MeasureName2=Item1Sold
MeasureName3=Item1Stock
MeasureName4=Item2Source
MeasureName5=Item2Sold
MeasureName6=Item2Stock
Text=#Item1#  %1        %2        %3#CRLF##Item2#    %4        %5        %6

And the csv data file is...

Code: Select all

Item,Source,Sold
Tomato,100,48
Apple,120,34

This skin updates data display every 10 seconds and calculates Stock from Source and Sold numbers.

But this skin does not work when Excel leaves the data csv file open due to access violation. So, you have to close Excel after the data input. I am not sure about the solution of this issue, but some data export macro on Excel may help??

mak_kawa · Post by **mak_kawa** » October 31st, 2019, 3:50 am

Maybe there is a lot of other easier way(s). And also I am really not sure that my post helps you...but anyway;

Create a macro on your EXCEL sheet with macro (= xlsm format) from macro dialog with any macro name. Add two modules as standard module.

module name: Module1 (or anything)

Code: Select all

Option Explicit

Const EXT As String = ".csv"

Sub CSV_export()
  Dim Filename As String
  Filename = Mid(ActiveWorkbook.Name, 1, InStrRev(ActiveWorkbook.Name, ".") - 1) & EXT
  
  Dim Filepath As String
  Filepath = ActiveWorkbook.Path & "\" & Filename
  
  Call CSV.Output(ActiveSheet, Filepath)
  
  MsgBox "Export csv data to " & Filepath
End Sub

module name:CSV

Code: Select all

Option Explicit

Enum CSVCols
  Default = 0
  force = 1
  Ignore = 2
End Enum

Function Output(TargetSheet As Worksheet, ByVal Filepath As String, _
    Optional ByVal StartRow As Long = 1, Optional ByVal EndRow As Long = 0, _
    Optional ByVal StartCol As Long = 1, Optional ByVal EndCol As Long = 0, _
    Optional ByVal WithFormatCols As String = "", Optional ByVal WithoutFormatCols As String = "", _
    Optional ByVal WithQuoteCols As String = "", Optional ByVal WithoutQuoteCols As String = "", _
    Optional ByVal Delimitar As String = ",", Optional ByVal LineEndingCode As String = vbCr & vbLf, _
    Optional ByVal QuoteChar As String = """", Optional ByVal CharReplaceQuote As String = """""", _
    Optional ByVal Charset As String = "shift_jis") As Boolean

  If EndRow = 0 Then
    EndRow = getLastRow(TargetSheet)
  End If

  If EndCol = 0 Then
    EndCol = getLastColumn(TargetSheet)
  End If

  Dim FormatOptionOfColumns() As Long
  FormatOptionOfColumns = setOption(WithFormatCols, WithoutFormatCols, StartCol, EndCol)

  Dim QuoteOptionOfColumns() As Long
  QuoteOptionOfColumns = setOption(WithQuoteCols, WithoutQuoteCols, StartCol, EndCol)

  Dim csvData As String

  Dim rowData() As String
  ReDim rowData(0 To EndCol - StartCol) As String
  
  Dim R As Long
  Dim C As Long
  For R = StartRow To EndRow
    For C = StartCol To EndCol
      rowData(C - StartCol) = convertFormatTowriteCSVFile(TargetSheet.Cells(R, C), StartCol, _
                                            Delimitar, QuoteChar, CharReplaceQuote, _
                                            FormatOptionOfColumns, QuoteOptionOfColumns)
    Next

    csvData = csvData & Join(rowData, Delimitar) & LineEndingCode
  Next

  Output = writeCSVFile(csvData, Filepath, Charset)

End Function

Private Function getLastRow(TargetSheet As Worksheet) As Long
 
  Dim Row As Long
  Dim Column As Long

  For Row = TargetSheet.UsedRange.Row + TargetSheet.UsedRange.Rows.Count - 1 To 1 Step -1
    For Column = TargetSheet.UsedRange.Column + TargetSheet.UsedRange.Columns.Count - 1 To 1 Step -1
      If TargetSheet.Cells(Row, Column).Value <> "" Then
        GoTo Finally
      End If
    Next
  Next

Finally:
  getLastRow = Row
End Function

Private Function getLastColumn(TargetSheet As Worksheet) As Long
  Dim Row As Long
  Dim Column As Long

  For Column = TargetSheet.UsedRange.Column + TargetSheet.UsedRange.Columns.Count - 1 To 1 Step -1
    For Row = TargetSheet.UsedRange.Row + TargetSheet.UsedRange.Rows.Count - 1 To 1 Step -1
      If TargetSheet.Cells(Row, Column).Value <> "" Then
        GoTo Finally
      End If
    Next
  Next

Finally:
  getLastColumn = Column
End Function

Private Function setOption(WithCols As String, WithoutCols As String, minCol As Long, maxCol As Long)
  WithCols = "," & WithCols & ","
  WithoutCols = "," & WithoutCols & ","

  Dim ret() As Long
  ReDim ret(0 To maxCol - minCol)

  Dim C As Long
  For C = LBound(ret) To UBound(ret)
    If InStr(WithCols, "," & C + 1 & ",") Then
      ret(C) = CSVCols.force
    ElseIf InStr(WithoutCols, "," & C + 1 & ",") Then
      ret(C) = CSVCols.Ignore
    Else
      ret(C) = CSVCols.Default
    End If
  Next

  setOption = ret
End Function

Private Function convertFormatTowriteCSVFile(R As Range, BaseCol As Long, _
         Delimitar As String, QuoteChar As String, CharReplaceQuote As String, _
         FormatOptionOfColumns() As Long, QuoteOptionOfColumns() As Long)
  Dim Val As Variant
  Val = R.Value

  If FormatOptionOfColumns(R.Column - BaseCol) = CSVCols.force Or _
    FormatOptionOfColumns(R.Column - BaseCol) = CSVCols.Default And addFormat(Val) Then
    Val = R.Text
  End If

  If QuoteOptionOfColumns(R.Column - BaseCol) = CSVCols.force Or _
    QuoteOptionOfColumns(R.Column - BaseCol) = CSVCols.Default And AddQuote(Val, Delimitar, QuoteChar) Then
    Val = QuoteChar & Replace(Val, QuoteChar, CharReplaceQuote) & QuoteChar
  End If

  convertFormatTowriteCSVFile = Val
End Function

Private Function addFormat(Val As Variant) As Boolean
    addFormat = False
End Function

Private Function AddQuote(Val As Variant, Delimitar As String, QuoteChar As String) As Boolean
  If InStr(Val, Delimitar) Or InStr(Val, QuoteChar) Or _
     InStr(Val, vbLf) Or InStr(Val, vbCr) Then
    AddQuote = True
  Else
    AddQuote = False
  End If
End Function

Private Function writeCSVFile(csvData As String, Filepath As String, Charset As String) As Boolean
  Dim removeBom As Boolean

  If Charset = "utf-8n" Then
    Charset = "utf-8"
    removeBom = True
  Else
    removeBom = False
  End If

  Dim ST As Object
  Set ST = CreateObject("ADODB.stream")

  With ST
    .Mode = 3  'adModeReadWrite
    .Type = 2  'adTypeText
    .Charset = Charset

    .Open
    .WriteText csvData, 0  'adWriteChar
  End With

  If removeBom Then
    ST.Position = 0
    ST.Type = 1  'adTypeBinary
    ST.Position = 3

    Dim ST2 As Object
    Set ST2 = CreateObject("ADODB.stream")

    With ST2
      .Mode = 3  'adModeReadWrite
      .Type = 1  'adTypeBinary
      .Open

      .Write ST.Read

      .SaveToFile Filepath, 2  'adSaveCreateOverWrite
      .Close
    End With
  Else
    ST.SaveToFile Filepath, 2  'adSaveCreateOverWrite
  End If

  ST.Close
  writeCSVFile = True
End Function

Input "tomatoes sold" data on the EXCEL sheet and execute this macro, a csv file with same filename is created in the same folder. EXCEL has not "in-use" flag for this csv file, so the skin in above post does work with automatic update (10 seconds) even if the EXCEL file is opened.
To assign this macro to EXCEL tool button would be convenient. And if you feel annoyance with "Export completed" dialog, delete a MsgBox line in the Module1.

I am afraid that I am misunderstanding your intention and what you want...

PS. These EXCEL VBA macro codes modified from 経理・会計事務所向けエクセルスピードアップ講座 and removed Japanese characters as comments.

TriniMike · Post by **TriniMike** » October 31st, 2019, 1:22 pm

mak_kawa wrote: ↑October 31st, 2019, 3:50 am Maybe there is a lot of other easier way(s). And also I am really not sure that my post helps you...but anyway;

Create a macro on your EXCEL sheet with macro (= xlsm format) from macro dialog with any macro name. Add two modules as standard module.

module name: Module1 (or anything)

Code: Select all

Option Explicit

Const EXT As String = ".csv"

Sub CSV_export()
  Dim Filename As String
  Filename = Mid(ActiveWorkbook.Name, 1, InStrRev(ActiveWorkbook.Name, ".") - 1) & EXT
  
  Dim Filepath As String
  Filepath = ActiveWorkbook.Path & "\" & Filename
  
  Call CSV.Output(ActiveSheet, Filepath)
  
  MsgBox "Export csv data to " & Filepath
End Sub

module name:CSV

Code: Select all

Option Explicit

Enum CSVCols
  Default = 0
  force = 1
  Ignore = 2
End Enum

Function Output(TargetSheet As Worksheet, ByVal Filepath As String, _
    Optional ByVal StartRow As Long = 1, Optional ByVal EndRow As Long = 0, _
    Optional ByVal StartCol As Long = 1, Optional ByVal EndCol As Long = 0, _
    Optional ByVal WithFormatCols As String = "", Optional ByVal WithoutFormatCols As String = "", _
    Optional ByVal WithQuoteCols As String = "", Optional ByVal WithoutQuoteCols As String = "", _
    Optional ByVal Delimitar As String = ",", Optional ByVal LineEndingCode As String = vbCr & vbLf, _
    Optional ByVal QuoteChar As String = """", Optional ByVal CharReplaceQuote As String = """""", _
    Optional ByVal Charset As String = "shift_jis") As Boolean

  If EndRow = 0 Then
    EndRow = getLastRow(TargetSheet)
  End If

  If EndCol = 0 Then
    EndCol = getLastColumn(TargetSheet)
  End If

  Dim FormatOptionOfColumns() As Long
  FormatOptionOfColumns = setOption(WithFormatCols, WithoutFormatCols, StartCol, EndCol)

  Dim QuoteOptionOfColumns() As Long
  QuoteOptionOfColumns = setOption(WithQuoteCols, WithoutQuoteCols, StartCol, EndCol)

  Dim csvData As String

  Dim rowData() As String
  ReDim rowData(0 To EndCol - StartCol) As String
  
  Dim R As Long
  Dim C As Long
  For R = StartRow To EndRow
    For C = StartCol To EndCol
      rowData(C - StartCol) = convertFormatTowriteCSVFile(TargetSheet.Cells(R, C), StartCol, _
                                            Delimitar, QuoteChar, CharReplaceQuote, _
                                            FormatOptionOfColumns, QuoteOptionOfColumns)
    Next

    csvData = csvData & Join(rowData, Delimitar) & LineEndingCode
  Next

  Output = writeCSVFile(csvData, Filepath, Charset)

End Function

Private Function getLastRow(TargetSheet As Worksheet) As Long
 
  Dim Row As Long
  Dim Column As Long

  For Row = TargetSheet.UsedRange.Row + TargetSheet.UsedRange.Rows.Count - 1 To 1 Step -1
    For Column = TargetSheet.UsedRange.Column + TargetSheet.UsedRange.Columns.Count - 1 To 1 Step -1
      If TargetSheet.Cells(Row, Column).Value <> "" Then
        GoTo Finally
      End If
    Next
  Next

Finally:
  getLastRow = Row
End Function

Private Function getLastColumn(TargetSheet As Worksheet) As Long
  Dim Row As Long
  Dim Column As Long

  For Column = TargetSheet.UsedRange.Column + TargetSheet.UsedRange.Columns.Count - 1 To 1 Step -1
    For Row = TargetSheet.UsedRange.Row + TargetSheet.UsedRange.Rows.Count - 1 To 1 Step -1
      If TargetSheet.Cells(Row, Column).Value <> "" Then
        GoTo Finally
      End If
    Next
  Next

Finally:
  getLastColumn = Column
End Function

Private Function setOption(WithCols As String, WithoutCols As String, minCol As Long, maxCol As Long)
  WithCols = "," & WithCols & ","
  WithoutCols = "," & WithoutCols & ","

  Dim ret() As Long
  ReDim ret(0 To maxCol - minCol)

  Dim C As Long
  For C = LBound(ret) To UBound(ret)
    If InStr(WithCols, "," & C + 1 & ",") Then
      ret(C) = CSVCols.force
    ElseIf InStr(WithoutCols, "," & C + 1 & ",") Then
      ret(C) = CSVCols.Ignore
    Else
      ret(C) = CSVCols.Default
    End If
  Next

  setOption = ret
End Function

Private Function convertFormatTowriteCSVFile(R As Range, BaseCol As Long, _
         Delimitar As String, QuoteChar As String, CharReplaceQuote As String, _
         FormatOptionOfColumns() As Long, QuoteOptionOfColumns() As Long)
  Dim Val As Variant
  Val = R.Value

  If FormatOptionOfColumns(R.Column - BaseCol) = CSVCols.force Or _
    FormatOptionOfColumns(R.Column - BaseCol) = CSVCols.Default And addFormat(Val) Then
    Val = R.Text
  End If

  If QuoteOptionOfColumns(R.Column - BaseCol) = CSVCols.force Or _
    QuoteOptionOfColumns(R.Column - BaseCol) = CSVCols.Default And AddQuote(Val, Delimitar, QuoteChar) Then
    Val = QuoteChar & Replace(Val, QuoteChar, CharReplaceQuote) & QuoteChar
  End If

  convertFormatTowriteCSVFile = Val
End Function

Private Function addFormat(Val As Variant) As Boolean
    addFormat = False
End Function

Private Function AddQuote(Val As Variant, Delimitar As String, QuoteChar As String) As Boolean
  If InStr(Val, Delimitar) Or InStr(Val, QuoteChar) Or _
     InStr(Val, vbLf) Or InStr(Val, vbCr) Then
    AddQuote = True
  Else
    AddQuote = False
  End If
End Function

Private Function writeCSVFile(csvData As String, Filepath As String, Charset As String) As Boolean
  Dim removeBom As Boolean

  If Charset = "utf-8n" Then
    Charset = "utf-8"
    removeBom = True
  Else
    removeBom = False
  End If

  Dim ST As Object
  Set ST = CreateObject("ADODB.stream")

  With ST
    .Mode = 3  'adModeReadWrite
    .Type = 2  'adTypeText
    .Charset = Charset

    .Open
    .WriteText csvData, 0  'adWriteChar
  End With

  If removeBom Then
    ST.Position = 0
    ST.Type = 1  'adTypeBinary
    ST.Position = 3

    Dim ST2 As Object
    Set ST2 = CreateObject("ADODB.stream")

    With ST2
      .Mode = 3  'adModeReadWrite
      .Type = 1  'adTypeBinary
      .Open

      .Write ST.Read

      .SaveToFile Filepath, 2  'adSaveCreateOverWrite
      .Close
    End With
  Else
    ST.SaveToFile Filepath, 2  'adSaveCreateOverWrite
  End If

  ST.Close
  writeCSVFile = True
End Function

Input "tomatoes sold" data on the EXCEL sheet and execute this macro, a csv file with same filename is created in the same folder. EXCEL has not "in-use" flag for this csv file, so the skin in above post does work with automatic update (10 seconds) even if the EXCEL file is opened.
To assign this macro to EXCEL tool button would be convenient. And if you feel annoyance with "Export completed" dialog, delete a MsgBox line in the Module1.

I am afraid that I am misunderstanding your intention and what you want...

PS. These EXCEL VBA macro codes modified from 経理・会計事務所向けエクセルスピードアップ講座 and removed Japanese characters as comments.

Thank you very much for all your information! I'll be deciphering it to learn. this has given me a lot more insight into the program and just general programming as i have little to no experience but I understand the basics of it. Definitely my weakest area of knowledge as an I.T professional. there some other ideas i might be able to try, although I think i may try to find a different approach to the problem but, I appreciate your time! I hope you have a fantastic day.

mak_kawa · Post by **mak_kawa** » October 31st, 2019, 11:13 pm

Hi TriniMike

I am very sorry that my proposed solution is not in accordance with your aim. Maybe my misunderstanding. Maybe someone will suggest another solution.

Anyway, Rainmeter is, IMO, a scripting/programming platform that gives various/flexible solutions to a computer end-user like me. I have grown a bit through this quest for the cooperation of Rainmeter and Excel. Really fun.

PS. Note for someone interested, there is a minor flaw in the VBA code I presented above. In the 16th line of the module "CSV", variable Charset is set as "shift_jis". This is a local standard character encoding for my country, Japan. Probably you have to change this to "UTF-8" as global web standard for Webparser.

Self updating statistic widget

Self updating statistic widget

Re: Self updating statistic widget

Re: Self updating statistic widget

Re: Self updating statistic widget

Re: Self updating statistic widget

Re: Self updating statistic widget