Макрос для сохранения файла, если ячейки заполнены - PullRequest
0 голосов
/ 05 марта 2020

Я хочу сохранить свой файл в определенной папке SharePoint при нажатии кнопки.

В той же электронной таблице Excel у меня есть ячейки проверки данных, которые не должны быть пустыми. Если они не заполнены, макрос должен дать мне сообщение об ошибке и сказать, что некоторые ячейки не заполнены и должны быть заполнены. Если они не пустые, сохраните файл в папке SharePoint.

Мой макрос выглядит следующим образом:

Private Sub CommandButton1_Click()
Dim Path As String
Dim FileName1 As String

Path = "https://xxx.sharepoint.com/sites/xxxx/xxxxxxxxxxxxx/"
FileName1 = Range("$B$2").Text
ActiveWorkbook.SaveAs Filename:=Path & FileName1 & ".xlsx", _
                          FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
ActiveWorkbook.Close

End Sub

Ячейками являются AD9: AM9 и AD10: AM10

Ответы [ 2 ]

0 голосов
/ 05 марта 2020

Пожалуйста, используйте событие Workbook_BeforeSave, например:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim sh As Worksheet, rng As Range, emptRng As Range
    Set sh = ActiveSheet 'use here your sheet
    Set rng = sh.Range("AD9:AM10")
     On Error Resume Next
      Set emptRng = rng.SpecialCells(xlCellTypeBlanks)
      If Err.Number = 0 Then
        Cancel = True
        MsgBox "There are empty cells in the range " & rng.Address & "." & vbCrLf & _
               "Please check, correct and save again after that..."
      End If
     On Error GoTo 0
End Sub
0 голосов
/ 05 марта 2020

Этот оператор if проверяет, являются ли ячейки пустыми, и завершает макрос до сохранения, если диапазон пуст. Я объединил ваши диапазоны как они смежные.

Private Sub CommandButton1_Click()
Dim Path As String
Dim FileName1 As String


If WorksheetFunction.CountA(Range("AD9:AM10")) = 0  Then
        MsgBox "Data Validation Fields are empty"
        end ' stops the macro from running
Else

    Path = "https://xxx.sharepoint.com/sites/xxxx/xxxxxxxxxxxxx/"
    FileName1 = Range("$B$2").Text
    ActiveWorkbook.SaveAs Filename:=Path & FileName1 & ".xlsx", _
                          FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
End if

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...