Translate

顯示具有 VBA 標籤的文章。 顯示所有文章
顯示具有 VBA 標籤的文章。 顯示所有文章

2022年3月2日 星期三

2022年2月25日 星期五

利用VBA傳送訊息給Line

Token取得可以方式可參考"https://tomyam-yang.blogspot.com/2022/02/google-apps-scripline.html
Sub line_notify()
     '===================================
    'Line訊息
    '===================================
    Dim oXML As Object
   
    Dim Token As String
   
    Dim URL As String
   
    '指定的Line Notify Token
   
    Token = "你的TOKEN"
   
    'Line Notify的傳送訊息網址
       
    Line_Message = "利用VBA傳訊息"
   
    URL = "https://notify-api.line.me/api/notify"

    Set oXML = CreateObject("Microsoft.XMLHTTP")
   
    With oXML
   
        '使用同步傳輸
   
        .Open "POST", URL, 0
   
        '設定傳送封包Header
   
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   
        .setRequestHeader "Authorization", "Bearer " & Token
   
        '執行Ajax傳送
        .send "message=" & Chr(10) & Line_Message
        Debug.Print oXML.responseText
   
    End With
   
    '釋放物件資源
   
    Set oXML = Nothing
End Sub







參考資料:http://forum.twbts.com/thread-22487-1-1.html

2018年11月28日 星期三

透過Execl VBA將資料寫進google sheet(import or send data from Excel to Google sheet)

參考:透過Excel將資料寫進google sheet(import or send data from Excel to Google sheet)

詳細的使用方法上述參考網址都有,就不在敘述。

使用上的問題,當有修正Google Apps Script的程式時除了要重新發佈->部置為網路應用程式外專案版本也要變動。不然會一直是修正前的程式碼在執行。

可以將Google的試算表傳給任何人,當Excel上傳資料後,Google試算表約1~3秒就會更新。適合即時回報統計數值。

1、VBA副程式

Public Sub sendData2GoogleSheet()
    On Error GoTo handleerr
    num1 = Sheet1.Range("E2") '將excel的E2的欄位資料丟進num1的變數中
    num2 = Sheet1.Range("F2") '將excel的F2的欄位資料丟進num2的變數中
    num3 = Sheet1.Range("G2") '將excel的G2的欄位資料丟進num3的變數中
    num4 = Sheet1.Range("H2") '將excel的H2的欄位資料丟進num4的變數中
    num5 = Sheet1.Range("I2") '將excel的I2的欄位資料丟進num5的變數中
    num6 = Sheet1.Range("J2") '將excel的J2的欄位資料丟進num6的變數中
    num7 = Sheet1.Range("K2") '將excel的K2的欄位資料丟進num7的變數中
    num8 = Sheet1.Range("L2") '將excel的L2的欄位資料丟進num8的變數中
   '將資料寫進googlesheet
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    postData = "method=write&snum1=" & num1 & "&snum2=" & num2 & "&snum3=" & num3 & "&snum4=" & num4 & "&snum5=" & num5 & "&snum6=" & num6 & "&snum7=" & num7 & "&snum8=" & num8  '&與變數之間要空一格
    WinHttp.Open "POST", "這裡請填上你發佈的網路應用程式的網址", False
    WinHttp.setRequestHeader "authority", "script.google.com"
    WinHttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_13_4) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/65.0.3325.181 Safari/537.36"
    WinHttp.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    WinHttp.send postData
    MsgBox "傳送成功"
    Exit Sub
handleerr:
    MsgBox "傳送失敗"
 
End Sub

2、Google Apps Script

var sheet1=SpreadsheetApp.getActiveSpreadsheet().getSheetByName("sheet1"); 
 
function doPost(e) {
  var para = e.parameter, method = para.method; 
  if (method == "write") {
    write_data(para);
  }
}
function write_data(para) {
  var num1 = para.snum1,num2 = para.snum2,num3 = para.snum3,num4 = para.snum4,num5 = para.snum5,num6 = para.snum6,num7 = para.snum7,num8 = para.snum8; 
  var date = new Date();
  var now = date.getHours() + ':' + date.getMinutes() + ':' + date.getSeconds();
  sheet1.getRange(4,2).setValue(num1);
  sheet1.getRange(5,2).setValue(num2);
  sheet1.getRange(6,2).setValue(num3);
  sheet1.getRange(7,2).setValue(num4);
  sheet1.getRange(8,2).setValue(num5);
  sheet1.getRange(9,2).setValue(num7);
  sheet1.getRange(10,2).setValue(num8);
  sheet1.getRange(3,2).setValue(num6);
  sheet1.getRange(1,2).setValue(now);
}

2018年10月3日 星期三

Excel VBA選擇COM Port讀取Arduino資料

請先學習Excel VBA 尋找可用的RS232 port利用Excel VBA利用串列埠RS232讀取Arduino資料

新增一個NETComm1、TextBox1、CommandButton1、CommandButton2、ComboBox1、Label1

備註:TextBox1屬性MultiLine請設為True



表單畫面如下:

程式碼:

Private Sub CommandButton1_Click()
    On Error Resume Next
    NETComm1.SThreshold = 1
    NETComm1.RThreshold = 1
    NETComm1.CommPort = ComboBox1.Text
    If NETComm1.PortOpen = False Then  'if the serial port is closed
        NETComm1.PortOpen = True       'open the serial port
        CommandButton1.Enabled = False
    End If
    If Err Then MsgBox Error$, 48
End Sub

Private Sub CommandButton2_Click()
    'Close serial port on exit
    On Error Resume Next    'Error handler
    
    If NETComm1.PortOpen = True Then    'check if the serial port is open
        NETComm1.PortOpen = False       'close the serial port
    End If
    If Err Then MsgBox Error$, 48     'Display error in message box
    End
End Sub


Private Sub NETComm1_OnComm()
    Static Buffer As String
    Dim CRLFPos As Integer
    Buffer = Buffer & NETComm1.InputData 'or whatever name you use for the instance of NETComm
    
    CRLFPos = InStr(Buffer, vbCr)
    If CRLFPos > 0 Then
        Dim MyData As String
        d = Now()
        MyData = d & Mid(Buffer, 1, CRLFPos - 1) & vbCrLf
        TextBox1.Text = TextBox1.Text & MyData
        Buffer = ""
    End If
End Sub

Private Sub UserForm_Initialize()
    Dim i As Byte
    For i = 1 To 9
        If IsComPortAvailable(i) = True Then
            ComboBox1.AddItem i
        End If
    Next
End Sub

Private Sub UserForm_Terminate()
    'Close serial port on exit
    On Error Resume Next    'Error handler
    
    If NETComm1.PortOpen = True Then    'check if the serial port is open
        NETComm1.PortOpen = False       'close the serial port
    End If
    If Err Then MsgBox Error$, 48     'Display error in message box
    
End Sub
Function IsComPortAvailable(ByVal portNum As Integer) As Boolean
    Dim fnum As Integer
    On Error Resume Next
    fnum = FreeFile
    Open "COM" & CStr(portNum) For Binary Shared As #fnum
    If Err = 0 Then
        Close #fnum
        IsComPortAvailable = True
    End If
End Function



(Arduino程式碼在「利用Excel VBA利用串列埠RS232讀取Arduino資料」)文章內 

請選擇本身電腦Arduino com port

執行畫面:



Excel VBA 尋找可用的RS232 port

參考:VB如何得知可用的RS232 Port?

VBA 新增表單並新增一個CommandButtor1、ComboBox1

程式碼如下:

 
Private Sub CommandButton1_Click()
    End
End Sub

Private Sub UserForm_Initialize()
    Dim i As Byte
    For i = 1 To 9
        If IsComPortAvailable(i) = True Then
            ComboBox1.AddItem i
        End If
    Next
End Sub
Function IsComPortAvailable(ByVal portNum As Integer) As Boolean
    Dim fnum As Integer
    On Error Resume Next
    fnum = FreeFile
    Open "COM" & CStr(portNum) For Binary Shared As #fnum
    If Err = 0 Then
        Close #fnum
        IsComPortAvailable = True
    End If
End Function

執行畫面:



2018年10月2日 星期二

Excel在工作表新增 VBA控制項

Excel 2007-開發人員-設計模式是反灰無法使用



步驟一:Excel 2007-開發人員-Visual Basic 出現Microsoft Visual Basic-Book1縮小後就可以看到Excel 2007-開發人員-設計模式可以使用

Excel 2007-開發人員-插入-表單控制項

選擇表單控制項-按鍵

在工作表單空白處畫出一個按鍵-指定巨集-新增

巨集存放在Book1

模組自動會新增一個Module1

在程式碼新增

 
Sub 按鈕1_Click()
   MsgBox "第一個範例"
End Sub




回到工作表按下「按鈕一」跑出警告畫面


2018年10月1日 星期一

Excel VBA開啟檔案後自動執行表單

當已經設計好VBA表單,希望打開Excel檔就執行可以在VBAProject-Microsoft Excel物件-ThisWorkbook的程式碼中新增下列程式碼





Private Sub Workbook_Open()
    UserForm1.Show '表單名稱.show
End Sub

利用Excel VBA利用串列埠RS232讀取Arduino資料

使用:NetCommOCX

我的電腦係win7 32位元 請至   Updated installer for Windows 7


依NETCommOCX Information Page介紹安裝以系統管理員身分執行Setup.exe








Excel 2007 -->開發人員-->Visual Basic-->






新增一個NETComm1、TextBox1、CommandButton1、CommandButton2

NETComm1的commport記得要填上arduino使用的COM

將下列程式碼複制到VBA程式碼

Private Sub CommandButton1_Click()
    On Error Resume Next
    NETComm1.SThreshold = 1
    NETComm1.RThreshold = 1
    NETComm1.CommPort = 4
    If NETComm1.PortOpen = False Then  'if the serial port is closed
        NETComm1.PortOpen = True       'open the serial port
    End If
    If Err Then MsgBox Error$, 48
End Sub

Private Sub CommandButton2_Click()
    'Close serial port on exit
    On Error Resume Next    'Error handler
    
    If NETComm1.PortOpen = True Then    'check if the serial port is open
        NETComm1.PortOpen = False       'close the serial port
    End If
    If Err Then MsgBox Error$, 48     'Display error in message box
    End
End Sub

Private Sub NETComm1_OnComm()
    Dim d As Date
    Static Buffer As String
    Dim CRLFPos As Integer
    Buffer = Buffer & NETComm1.InputData 'or whatever name you use for the instance of NETComm
    
    CRLFPos = InStr(Buffer, vbCr)
    If CRLFPos > 0 Then
        Dim MyData As String
        d = Now()
        MyData = d & Mid(Buffer, 1, CRLFPos - 1) & vbCrLf
        TextBox1.Text = TextBox1.Text & MyData
        Buffer = ""
    End If
End Sub
Private Sub UserForm_Terminate()
    'Close serial port on exit
    On Error Resume Next    'Error handler
    
    If NETComm1.PortOpen = True Then    'check if the serial port is open
        NETComm1.PortOpen = False       'close the serial port
    End If
    If Err Then MsgBox Error$, 48     'Display error in message box
    
End Sub

Arduino接線圖


Arduino端程式碼

#include <DHT.h>
#define DHTPIN 2    // 設定DHT的接腳
#define DHTTYPE DHT11   // DHT 11 定義DHT的類型為DHT11
//#define DHTTYPE DHT22   // DHT 22  (AM2302), AM2321
DHT dht(DHTPIN, DHTTYPE);
void setup() {
  Serial.begin(9600);
  //Serial.println("DHT11 test!");
  dht.begin(); //啟動DHT
}
 
void loop() {
  // 每次偵測間隔2秒
  char ch=13;
  delay(2000);
  
  //讀取濕度
  float h = dht.readHumidity();
  //讀取攝氏溫度
  float t = dht.readTemperature();
  //讀取華氏溫度
  float f = dht.readTemperature(true);
 
  //檢查是不是有讀到資料
  if (isnan(h) || isnan(t) || isnan(f)) {
    Serial.println("Failed to read from DHT sensor! \n");
    return;
  }
  Serial.print("Humidity:");
  Serial.print(h,1); //顯示到小數點後一位
  Serial.print("%/");
  Serial.print("Temperature:");
  Serial.print(t,1);//顯示到小數點後一位
  Serial.print("C");
  Serial.print(ch);

}

Arduino透過串列埠傳送溫溼度數值給電腦的Excel VBA