如何將Excel永遠顯示在最上層?

用 API SetWindowPos~

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, y, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Public Sub MakeNormal(hwnd As Long)
SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End Sub

Public Sub MakeTopMost(hwnd As Long)
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End Sub

Sub OnTop()
Call MakeTopMost(Application.hwnd)
End Sub

Sub OnNor()
Call MakeNormal(Application.hwnd)
End Sub

Sub auto_open()
Application.OnKey key:="{F1}", procedure:="OnTop"
Application.OnKey key:="{F2}", procedure:="OnNor"
End Sub

加速VBA的方法:

加速VBA的方法:

1.關閉螢幕更新 : Application.ScreenUpdating = False 'True
2.禁止觸發事件 : Application.EnableEvents = False 'True
3.禁止交互模式 : Application.Interactive = False 'True
4.計算模式設定為手動 : Application.Calculation = xlCalculationManual 'xlCalculationAutomatic
5.儲存格寫法 : 請使用cells : cells(1,1).value > cells(1,1) > Range("A1") > [A1]
6.比較句 :
IF A THEN
IF B THEN
優於
IF A AND B THEN 與
IF A THEN
... ELSE IF B THEN
優於
IF A OR B then
7.IF 快於SELECT
8.IF/ELSE 快於 IIF
9.循環句
For 語句快於DO/WHILE
For/each快於for/to

10.使用With語句
11.盡量不用Variant類型
12.使用Option Explicit
13.給返回值一個明確的類型.
14使用left$,而不用left,使用int%,而不用int

15.set=nothing
16.有些工作表函數（方法）速度是很快的,比如FIND,VLOOKUP等,要記得使用它們,不要花力氣去做不討好的事。
17.當使用工作表函數時,操作對象應避免使用內存變量,那樣反而慢。

18.使用不相鄰的range前,先使用UNION,一次進行.

使用內存數組
1．內存變量的運算速度大大快於RANGE對象。
將RANGE數據寫入內存數組。
下面兩句將生成一個65536行,6列的數組。
用這種方法產生的數組都是兩維數組,即使引用的RANGE只有一行或一列。
下標始於1,不受option base設定的影響。
arr必需聲明為Variant類型。
Dim arr()
arr=range(“A1:F65536”)
將內存數組數據寫入RANGE。
在內存數組經過計算處理後,寫回時只需下句就可以了。
range(“A1:F65536”)= arr
2．非數組變量快於數組變量。
當數組很大時,根據下標提取數值會比從單個變量慢得多,這時可以把需要多
次使用的數組值先賦給內存變量。
3．減少使用REDIM的次數。
REDIM是對數組操作中最費時的動作。
可以先預算大小,不夠或多餘時再進行調整。

移除VBA.xls.xla 密碼 保護

移除VBA.xls.xla 密碼 保護

'移除VBA编码保护
Sub MoveProtect()
Dim FileName As String
FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
If FileName = CStr(False) Then
Exit Sub
Else
VBAPassword FileName, False
End If
End Sub

'设置VBA编码保护
Sub SetProtect()
Dim FileName As String
FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
If FileName = CStr(False) Then
Exit Sub
Else
VBAPassword FileName, True
End If
End Sub

Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)
If Dir(FileName) = "" Then
Exit Function
Else
FileCopy FileName, FileName & ".bak"
End If

Dim GetData As String * 5
Open FileName For Binary As #1
Dim CMGs As Long
Dim DPBo As Long
For i = 1 To LOF(1)
Get #1, i, GetData
If GetData = "CMG=""" Then CMGs = i
If GetData = "[Host" Then DPBo = i - 2: Exit For
Next

If CMGs = 0 Then
MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
Exit Function
End If

If Protect = False Then
Dim St As String * 2
Dim s20 As String * 1

'取得一个0D0A十六进制字串
Get #1, CMGs - 2, St

'取得一个20十六制字串
Get #1, DPBo + 16, s20

'替换加密部份机码
For i = CMGs To DPBo Step 2
Put #1, i, St
Next

'加入不配对符号
If (DPBo - CMGs) Mod 2 <> 0 Then
Put #1, DPBo + 1, s20
End If
MsgBox "文件解密成功......", 32, "提示"
Else
Dim MMs As String * 5
MMs = "DPB="""
Put #1, CMGs, MMs
MsgBox "对文件特殊加密成功......", 32, "提示"
End If
Close #1
End Function

如何把yahoo奇摩拍賣的評價匯入EXCEL,使用巨集或VBA

如何把yahoo奇摩拍賣的評價匯入EXCEL,使用巨集或VBA

• 以下VBA執行前,請將UserID填入自己的Yahoo拍賣ID喔,並請登入yahoo拍賣.
• 將以下VBA原封不動copy的module1下即可.
• 沒有寫的很完整,想要防呆或增加功能,就自己試試囉~
• 若要捉別人的,程式只要做小修改即可......

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Sub GetYahooEva()
UserID = "xxxxxx" '請填入自己的帳號
HtmlFile = "C:\JackyLu.txt"
TargetUser = "http://tw.user.bid.yahoo.com/tw/show/rating?userID=" & UserID
DownloadFile CStr(TargetUser), CStr(HtmlFile)

AllData = UTF8ToBig5(HtmlFile)
TargetDataStart = "共 "
TargetDataStartLen = Len(TargetDataStart)
TargetDataStartPosition = InStr(AllData, TargetDataStart)

TargetDataStop = "<"
TargetDataStopLen = Len(TargetDataStop)
TargetDataStopPosition = InStr(TargetDataStartPosition + TargetDataStartLen, AllData, TargetDataStop)
SheetCnt = Mid(AllData, TargetDataStartPosition + TargetDataStartLen, TargetDataStopPosition - TargetDataStartPosition - TargetDataStartLen)
Workbooks.Add
Sheet1.Name = Format(Date, "yyyymmdd") & Format(Time, "hhmmss")
For SHN = 1 To SheetCnt
TargetUser = "http://tw.user.bid.yahoo.com/tw/show/rating?userID=" & UserID & "&pageNo=" & SHN
DownloadFile CStr(TargetUser), CStr(HtmlFile)
AllData = UTF8ToBig5(HtmlFile)
AllData = ReplaceUnnecessary(AllData)
AllData = TrimAllBlank(AllData)
Do
TargetDataStart = "評價為："
TargetDataStartLen = Len(TargetDataStart)
TargetDataStartPosition = InStr(AllData, TargetDataStart)
TargetDataStop = "[回應]"
TargetDataStopLen = Len(TargetDataStop)
TargetDataStopPosition = InStr(TargetDataStartPosition + TargetDataStartLen, AllData, TargetDataStop)

If TargetDataStartPosition <> 0 Then
T = Mid(AllData, TargetDataStartPosition, TargetDataStopPosition - TargetDataStartPosition)
NL1 = "買家滿意度"
NL2 = "意見︰"
NL3 = "回覆︰"
T = Replace(T, NL1, Chr(10) & NL1)
T = Replace(T, NL2, Chr(10) & NL2)
T = Replace(T, NL3, Chr(10) & NL3)
x = x + 1
Cells(x, 1).FormulaR1C1 = T
AllData = Mid(AllData, TargetDataStopPosition)
Else
Exit Do
End If
Loop
Next
Columns("A:A").ColumnWidth = 200
Cells.EntireRow.AutoFit
ActiveWindow.Zoom = 75
End Sub

Function UTF8ToBig5(HtmlFile)
Dim objStream As Object
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Type = 2
.Mode = 3
.Open
.Charset = "Big5" 'utf-8 Big5 或其他編碼
.LoadFromFile HtmlFile
UTF8ToBig5 = .ReadText
.Close
End With
End Function

Function TrimAllBlank(TrimB)
TrimB = Replace(TrimB, " ", "")
If InStr(TrimB, " ") > 0 Then
TrimB = TrimAllBlank(TrimB)
End If
TrimAllBlank = TrimB
End Function

Function ReplaceUnnecessary(RUString)
RUString = Replace(RUString, Chr(9), "")
RUString = Replace(RUString, Chr(13), "")
RUString = Replace(RUString, Chr(10), "")
RUString = Replace(RUString, " ", "")
Do
LI = InStr(RUString, "<") If LI = 0 Then Exit Do RI = InStr(LI, RUString, ">")
RUString = Replace(RUString, Mid(RUString, LI, RI - LI + 1), "")
Loop
ReplaceUnnecessary = RUString
End Function

Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function

VBA Data Types ( 變數型態)

VBA Data Types

VBE Hot-Key(熱鍵)

VBE Hot-Key

破解Excel 保護工作表 的密碼

破解Excel 保護工作表 的密碼

以下VBA可以查出[保護工作表]的密碼.
此為4位數的[英數密碼], 可自行修改以符合自己的需求.

Sub JackyCP()
Dim DimArr(63)
Dim PW As String
For x = 48 To 57
xx = xx + 1
DimArr(xx) = Chr(x)
Next
For x = 97 To 122
xx = xx + 1
DimArr(xx) = Chr(x)
NextFor x = 65 To 90
xx = xx + 1
DimArr(xx) = Chr(x)Next
On Error Resume Next
For x1 = 1 To UBound(DimArr) - 1
For x2 = 1 To UBound(DimArr) - 1
For x3 = 1 To UBound(DimArr) - 1
For x4 = 1 To UBound(DimArr) - 1
PW = DimArr(x1) & DimArr(x2) & DimArr(x3) & DimArr(x4)
Application.StatusBar = PW
ActiveSheet.Unprotect PW
If ActiveSheet.ProtectContents = False Then
MsgBox "Password is " & PW
Exit Sub
End If
Next
Next
Next
Next
End Sub

破解excel保護密碼

破解excel保護密碼


1.到「http://www.straxx.com/excel/password.html 」下載「password.xla」 這個檔案。

2.打開有保護的Excel文件，在功能表上的【工具】按一下滑鼠左鍵，接著從選單中點選【增益集】。

3.按下「增益集」對話盒中的〔瀏覽〕，接著找到剛才下載的位置，點選「password.xla」後按下〔確定〕。

4.接著你會發現選項中多了「Password recover」，勾選之後再按下對話盒中的〔確定〕。

5.接下來會出現一個提示訊息對話盒，沒關係，直接在〔確定〕上按一下滑鼠左鍵繼續下一個步驟。

6.再來破解保護！點選左下角要破解的〔Sheet〕後，按下功能表中的【工具】，接著從選單中點選【Unprotect sheet】，以去除工作表的保護！

7.最後解除保護了，總共花了1分03秒！依照表格及密碼的複雜程度，會秏時不同的破解時間，但還是遠比「暴力破解法」來得快，按下〔確定〕就可以繼續編輯文件囉！

Excel 檔案修復功能

Excel檔案毀損時,可用excel內建的修復功能!
(Excel 2002後才有此功能)

1. 開啟excel
2. Ctrl+O
3. 點選要開啟的檔案
4. 在該視窗右下角,按一下[開啟]按鈕右邊小箭頭.
5. 選擇[開啟並修復].[修復]
6. 開啟後,再另存新檔.
7. 如果不能修復,就選擇[開啟並修復].[抽選資料]

影片檔示範:

1. 工具
2. 選項
3. 安全性
4. 巨集安全性
5. 選 [中]安全性

如何將VBA工具列放到Excel控制列

影片檔示範:

1. 檢視
2. 工具列
3. Visual Basic
4. 將新增的VBA工具列拉到合適的位置

將Flash嵌入Excel中

影片檔示範:
1. 將 FLASH 存成 SWF 檔
2. 打開 Excel
3. 按功能表中「檢視」→「工具列」把「控制工具箱」的工具列顯示出來
4. 點「其他控制項」鈕選「shockwave flash object」
5. 標出現十字型，在 Excel 中拖曳出一個矩型，這個矩型中間會打一個 x，最好和您的 FLASH 動畫一樣大
6.點選這個矩型，再按「控制工具箱」中的「屬性」鈕，出現屬性的設定視窗
7.在影片的欄位中，輸入您的 FLASH 動畫的位置及完整名如：D:\x.swf
8.將 EmbedMovie 項設置為 True
9.按確定，關閉其他視窗，撥放投影片就看到了(會自動撥)
10.Word 及 Power Point 也適用

本影片榮獲Yahoo知識+,[ 知識影片 ] 之一!!

http://tw.myblog.yahoo.com/knowledge-plus/article?mid=5375&prev=-1&next=5337