零股紀念品-挑股到領取
以下用2018年聯電(2303)為例來看股東常會、零股買進、電子投票、領取紀念品時間。
其中的最後買進日(紅色區)，要特別注意。
在這之前必需持有該公司的股數(不限千股、零股)，才能繼續之後的補單、電投、領取紀念品。
電投在2018年開始大量執行(零股一定要電投才能有機會領到紀念品)，看甘特圖中的(綠色區)。
除非股東親自到股東會場領取紀念品，否則電投是零股領取紀念品的最佳方式。
用EXCEL做出甘特圖，操作方式:
2018年10月16日 星期二
2018年10月15日 星期一
2018年10月7日 星期日
假買屋真詐財-影片整理
假買屋真詐財-系列影片整理
真人真事，詐騙讓受害人入套的手法，值得多多了解。
詐騙手法層出不窮，了解越多，越能保護自己。
魔鬼總是藏在細節裡，你能發現嗎?
房屋沒貸款的，由買方自找代書、買賣簽約內容。
都是一系列的步局，花些時間看完以下影片吧。
以下影片中主角
陳國帥,沈咨凡,朱克立,林俊誠,林榮皓,周建璋,張香堯,李孟烽,江欣耘(女),林芝宇(女)...這些名字大家記住
房屋沒貸款的，由買方自找代書、買賣簽約內容。
都是一系列的步局，花些時間看完以下影片吧。
以下影片中主角
陳國帥,沈咨凡,朱克立,林俊誠,林榮皓,周建璋,張香堯,李孟烽,江欣耘(女),林芝宇(女)...這些名字大家記住
《夢想街之全能事務所》 - 假買房詐騙案EP01 網路獨播版
獨家...假買房真詐騙？還是買賣糾紛？ 當事者雙方「首次對質」！
《夢想街之全能事務所》 - 假買房詐騙案EP02 網路獨播版
假買房真詐騙？受害者現身說法！ 賣房財屋兩失 為何沈代書喊冤？
《夢想街之全能事務所》 - 假買房詐騙案EP03 網路獨播版
假買屋真詐騙？還是買賣糾紛？房子尾款收不到 竟變入股金？
《夢想街之全能事務所》 - 假買房詐騙案EP04 網路獨播版
完美騙局？買賣糾紛？關鍵人物對質 真相越來越明！？
《夢想街之全能事務所》 - 假買房詐騙案EP05 網路獨播版
真詐騙？假糾紛？賣屋賣到財屋兩失 獨家內幕大追蹤！
《夢想街之全能事務所》 - 假買房詐騙案EP06 網路獨播版
詐騙？糾紛？40多案竟都有驚人巧合 公部門終於動起來 北市地政局要出手了
《夢想街之全能事務所》 - 假買房詐騙案EP07 網路獨播版
假買房真詐騙？買賣糾紛？受害者血本無歸？ 集團「步步精心」！？
《夢想街之全能事務所》 - 假買房詐騙案EP08 網路獨播版
假買房真詐騙政府動了！議員質疑內神通外鬼？
《夢想街之全能事務所》 - 假買房詐騙案EP09 網路獨播版
假買房真詐騙！議員質疑內神通外鬼？ 市長允諾成立專案小組！
《夢想街之全能事務所》 - 假買房詐騙案EP10 網路獨播版
連90歲老人棺材本都騙！詐騙集團喪盡天良 檢調別再輕放！
《夢想街之全能事務所》 - 假買房詐騙案EP11網路獨播版
爽休一天警局一日遊？ 詐騙集團幾乎全放了！
以下是李慶元議員市政總質詢的資料
2018年10月4日 星期四
零股紀念品-必買股(原因分析)
股東紀念品-必買股(原因分析)
股東紀念品中，有某些公司是必買的(不論零股或千股)，只要買進後，持續持有股數，至少每年都能領取到紀念品。
其原因不外乎，每年皆有發放紀念品、經濟價值高、方便領取等優先選項。
禮券類的就是每年最佳必買進的項目，在股東常會的最後買進日前，就需早早買進。
以下是2018年實際領取到的禮券面額。
(以一個人領取為計算)
無面額的禮卷，暫不列入面額計算中。
光是面額總計扣除領取成本後，仍有剩餘價值。
2018年10月1日 星期一
更改資料標籤工具
一直在網路上尋找，變更EXCEL圖表標籤的工具。
其巨集內容如下。存放於部落格備用，該工具可以省去不少人工修改操作。
簡體內容變亂碼，重新修改成看的懂內容。
Option Explicit
Sub DataLableChange()
Dim I%, LblCnt%, iRows%, iCols%
Dim shnm$, sn$, Msg$
Dim rngLbl As Range
Select Case TypeName(Selection)
Case "DataLabel"
sn = Selection.Parent.Parent.Name
Case "DataLabels"
sn = Selection.Parent.Name
Case "Series"
sn = Selection.Name
Case Else
MsgBox "請先選擇要變更的標籤,再執行此巨集", vbOKOnly, "尚未選擇要變更的資料標籤"
Exit Sub
End Select
Err.Clear: On Error Resume Next
Set rngLbl = Application.InputBox("請輸入標籤所引用的區域,可以用滑鼠選擇區域", "標籤的引用區域", , , , , , 8)
Err.Clear: On Error GoTo 0
If rngLbl Is Nothing Then Exit Sub
iRows = rngLbl.Rows.Count
iCols = rngLbl.Columns.Count
LblCnt = ActiveChart.SeriesCollection(sn).Points.Count
shnm = rngLbl.Parent.Name
If Application.Max(iRows, iCols) < ActiveChart.SeriesCollection(sn).Points.Count Then
Msg = MsgBox("所引用的區域與標籤區域數量不符" & Chr(10) & "選""Yes""依選擇區域更改" & Chr(10) & "選""No""重新選擇區域", vbYesNo, "警告")
Select Case Msg
Case vbYes
LblCnt = Application.Max(iRows, iCols)
Case vbNo
Exit Sub
End Select
End If
Application.ScreenUpdating = False
On Error Resume Next
With ActiveChart.SeriesCollection(sn)
For I = 1 To LblCnt
Err.Clear
.Points(I).ApplyDataLabels
If Err.Number = 0 Then
If iRows > iCols Then
.Points(I).DataLabel.Text = "='" & shnm & "'!" & rngLbl.Cells(I, 1).Resize(1, iCols).Address(ReferenceStyle:=xlR1C1)
Else
.Points(I).DataLabel.Text = "='" & shnm & "'!" & rngLbl.Cells(1, I).Resize(iRows, 1).Address(ReferenceStyle:=xlR1C1)
End If
End If
Next
End With
Err.Clear: On Error GoTo 0
Application.ScreenUpdating = True
End Sub
其巨集內容如下。存放於部落格備用，該工具可以省去不少人工修改操作。
簡體內容變亂碼，重新修改成看的懂內容。
Option Explicit
Sub DataLableChange()
Dim I%, LblCnt%, iRows%, iCols%
Dim shnm$, sn$, Msg$
Dim rngLbl As Range
Select Case TypeName(Selection)
Case "DataLabel"
sn = Selection.Parent.Parent.Name
Case "DataLabels"
sn = Selection.Parent.Name
Case "Series"
sn = Selection.Name
Case Else
MsgBox "請先選擇要變更的標籤,再執行此巨集", vbOKOnly, "尚未選擇要變更的資料標籤"
Exit Sub
End Select
Err.Clear: On Error Resume Next
Set rngLbl = Application.InputBox("請輸入標籤所引用的區域,可以用滑鼠選擇區域", "標籤的引用區域", , , , , , 8)
Err.Clear: On Error GoTo 0
If rngLbl Is Nothing Then Exit Sub
iRows = rngLbl.Rows.Count
iCols = rngLbl.Columns.Count
LblCnt = ActiveChart.SeriesCollection(sn).Points.Count
shnm = rngLbl.Parent.Name
If Application.Max(iRows, iCols) < ActiveChart.SeriesCollection(sn).Points.Count Then
Msg = MsgBox("所引用的區域與標籤區域數量不符" & Chr(10) & "選""Yes""依選擇區域更改" & Chr(10) & "選""No""重新選擇區域", vbYesNo, "警告")
Select Case Msg
Case vbYes
LblCnt = Application.Max(iRows, iCols)
Case vbNo
Exit Sub
End Select
End If
Application.ScreenUpdating = False
On Error Resume Next
With ActiveChart.SeriesCollection(sn)
For I = 1 To LblCnt
Err.Clear
.Points(I).ApplyDataLabels
If Err.Number = 0 Then
If iRows > iCols Then
.Points(I).DataLabel.Text = "='" & shnm & "'!" & rngLbl.Cells(I, 1).Resize(1, iCols).Address(ReferenceStyle:=xlR1C1)
Else
.Points(I).DataLabel.Text = "='" & shnm & "'!" & rngLbl.Cells(1, I).Resize(iRows, 1).Address(ReferenceStyle:=xlR1C1)
End If
End If
Next
End With
Err.Clear: On Error GoTo 0
Application.ScreenUpdating = True
End Sub
訂閱：
文章 (Atom)