VBA代理，方法失敗，工作表失效

我已經創建了一個代碼，從網站中提取某些數據，將其添加到工作表，然後檢查它是哪一天並修改進度條（僅表格中的列）。然後代碼將當前結果保存在圖紙上並最終將其設置爲壁紙。起初我必須處理「未知」問題。我運行代碼並失敗了。但是當我一步一步地調試它時，它運行得非常完美。我發現我的工作簿必須被破壞。所以我將VBA複製到一個新的工作簿中，最後代碼運行正常。幾天後，我開始出現像單元格對象全局失敗等錯誤。我讀到它發生在某些對象沒有被充分定義的情況下，所以我將thisworkbook.sheets(1).cells添加到錯誤出現的每個單元格對象。這並沒有幫助，因爲即使在最基本的基本內容中，錯誤也開始出現。所以我轉移開始工作簿揭示了問題。或者我想..每次運行它時宏都會刪除當前表單。幾天後它沒有。只是沒有改變..我會粘貼下面的代碼。工作簿是否再次損壞？如何避免？VBA代理，方法失敗，工作表失效

Option Explicit 

Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _ 
         (ByVal uAction As Long, ByVal uParam As Long, _ 
         ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long 

Public Const SPI_SETDESKWALLPAPER = 20 
Public Const SPIF_SENDWININICHANGE = &H2 
Public Const SPIF_UPDATEINIFILE = &H1 
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 

Sub Auto_Open() 
    Call getDataFromWebsite 
    Call weekProgress 
    Call saveSheet 
    Call changeWallpaper 
    ThisWorkbook.Close SaveChanges:=False 
    Application.Quit 
End Sub 

Sub getDataFromWebsite() 
Dim x As String 
Dim IE As Object 
Dim HtmlCon As HTMLDocument 
Dim element As Object 
Dim ArrivalTime 

    On Error GoTo Handler 
    x = "someWebsite" 
    Set IE = New InternetExplorerMedium 
    IE.Navigate (x) 
    IE.Visible = False 
    Do While IE.ReadyState <> 4 
     DoEvents 
    Loop 
    Set HtmlCon = IE.document 
    Set element = HtmlCon.getElementsByClassName("someclassname") 
    ArrivalTime = element(0).innerText 
    ThisWorkbook.Sheets(1).Cells(3, 15).Value = ArrivalTime 
Handler: 
    IE.Quit 
End Sub 


Sub weekProgress() 
Dim caseResult As String 
Dim offsetDayIndex As Integer 
Const dayBarLenght = 2 

    Select Case Application.WorksheetFunction.Weekday(Date, 2) 
     Case 1 
      caseResult = "Monday" 
      offsetDayIndex = 0 
     Case 2 
      caseResult = "Tuesday" 
      offsetDayIndex = 1 
     Case 3 
      caseResult = "Wednesday" 
      offsetDayIndex = 2 
     Case 4 
      caseResult = "Thursday" 
      offsetDayIndex = 3 
     Case 5 
      caseResult = "Friday" 
      offsetDayIndex = 4 
     Case Else 
      caseResult = "Monday" 
    End Select 
DoEvents 
ThisWorkbook.Sheets(1).Cells(24, 11).Value = caseResult 
ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).Cells(31, 5), ThisWorkbook.Sheets(1).Cells(31, 12)).Interior.ColorIndex = 1 
If Not caseResult = "Monday" Then 
    ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).Cells(31, 5), ThisWorkbook.Sheets(1).Cells(31, 4 + (dayBarLenght * offsetDayIndex))).Interior.ColorIndex = 2 
End If 

End Sub 



Sub saveSheet() 
Dim oCht As Object 
Dim zoom_coef 
Dim area 

zoom_coef = 100/ThisWorkbook.Sheets(1).Parent.Windows(1).Zoom 
Set area = ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).PageSetup.PrintArea) 
DoEvents 
area.CopyPicture xlPrinter 

    Application.DisplayAlerts = False 
    DoEvents 
    Set oCht = ThisWorkbook.Sheets(1).ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef) 
    DoEvents 
    DoEvents 
    oCht.Chart.Paste 
    DoEvents 
    DoEvents 
    oCht.Chart.Export Filename:="somepath\savedImage.bmp", Filtername:="bmp" 
    DoEvents 
    oCht.Delete 
    Application.DisplayAlerts = True 

End Sub 

Sub changeWallpaper() 
Dim strImagePath As String 

    strImagePath = "somepath\savedImage.bmp" 
    Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, strImagePath, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) 

End Sub 






Sub saveSheetBackup() 
Dim oCht 
Worksheets("List1").Range("B2:Q37").CopyPicture xlScreen, xlBitmap 

    Application.DisplayAlerts = False 
    Set oCht = Charts.Add 
    DoEvents 
    oCht.Paste 
    DoEvents 
    oCht.Export Filename:="somepath\savedImage.bmp", Filtername:="bmp" 
    DoEvents 
    oCht.Delete 
    Application.DisplayAlerts = True 
End Sub

來源

2017-08-10 Lance

我有一個頓悟。我用簡單的Application.Quit替代了Thisworkbook.Close，警報被禁用了，這就實現了。我仍然不明白爲什麼在不保存的情況下關閉工作簿會完全刪除工作表。有人可以啓發我嗎？

來源

2017-08-10 08:19:04 Lance

VBA代理，方法失敗，工作表失效

回答

相關問題