Ayuda para terminar esta macro

[vicpower]

Buenas gente! Les comento que me falta una variable para terminar la Macro que les voy a detallar y no se como ponerla.

Esta Macro lo que hace es enviar por mail cada hoja a cada mail que esta detallado en la celda B2, por ejemplo de la hoja Eje.

Lo que yo necesito hacer para terminar la Macro es que si la celda D12=0 no la mande por mail (esto se debe repetir por cada hoja que agregue)...

La macro es esta:

Private Sub CommandButton1_Click()

On Error GoTo ControlError

Dim Sourcewb As Workbook, Destwb As Workbook

Dim TempFilePath As String, TempFileName As String

Dim strdate As String, strTo As String, StrAsunto As String

Dim StrMsg As String, StrFirma1 As String, StrFirma2 As String

Dim OutApp As Outlook.Application, OutMail As Outlook.MailItem

Dim nHojas As Integer

With Application

  .ScreenUpdating = False

  .EnableEvents = False

End With

Set Sourcewb = ActiveWorkbook

StrAsunto = Worksheets(1).Range("B17").Text

StrMsg = Worksheets(1).Range("B18").Text

StrFirma1 = Worksheets(1).Range("B19").Text

StrFirma2 = Worksheets(1).Range("B5").Text

For nHojas = 6 To Sheets.Count

  Sourcewb.Activate

  Worksheets(nHojas).Activate

  strTo = Worksheets(nHojas).Range("B2").Text

  If strTo = "" Then

  MsgBox "No existe correo asociado en la hoja especificada :" & ActiveSheet.Name & ", Verifique por favor.", vbOKOnly

  Exit Sub

  End If

  ActiveSheet.Copy

  Set Destwb = ActiveWorkbook

  TempFilePath = Environ$("temp") & "\"

  TempFileName = "Autorizaciones RC del Día - " & ActiveSheet.Name

  With Destwb

  .SaveAs TempFilePath & TempFileName & ".xls", FileFormat:=-4143

  .SendMail strTo, StrAsunto & ActiveSheet.Name

  'Set OutApp = New Outlook.Application

  'Set OutMail = OutApp.CreateItem(olMailItem)

  'With OutMail

  '  .Recipients.Add (strTo)

  '  .Subject = StrAsunto & ActiveSheet.Name & " Fecha :" & strdate

  '  .Body = StrMsg & vbCrLf & vbCrLf & vbCrLf & vbCrLf & StrFirma1 & vbCrLf & StrFirma2

  '  .Attachments.Add Destwb.FullName

  '  .Send

  'End With

  .Close

  Set OutMail = Nothing

  Set OutApp = Nothing

  End With

  Kill TempFilePath & TempFileName & ".xls"

  With Application

  .ScreenUpdating = True

  .EnableEvents = True

  End With

Next

Exit Sub

ControlError:

  MsgBox "Se a detectado un error :" + Err.Number, vbCritical

End Sub[/CODE]

Desde ya mil gracias!!!

[4c7569735f50]

prueba así.

Private Sub CommandButton1_Click()

On Error GoTo ControlError

Dim Sourcewb As Workbook, Destwb As Workbook

Dim TempFilePath As String, TempFileName As String

Dim strdate As String, strTo As String, StrAsunto As String

Dim StrMsg As String, StrFirma1 As String, StrFirma2 As String

Dim OutApp As Outlook.Application, OutMail As Outlook.MailItem

Dim nHojas As Integer

With Application

  .ScreenUpdating = False

  .EnableEvents = False

End With

Set Sourcewb = ActiveWorkbook

StrAsunto = Worksheets(1).Range("B17").Text

StrMsg = Worksheets(1).Range("B18").Text

StrFirma1 = Worksheets(1).Range("B19").Text

StrFirma2 = Worksheets(1).Range("B5").Text

For nHojas = 6 To Sheets.Count

If Sheets(nHojas).Range("d2") = 0 Then GoTo 1

  Sourcewb.Activate

  Worksheets(nHojas).Activate

  strTo = Worksheets(nHojas).Range("B2").Text

  If strTo = "" Then

  MsgBox "No existe correo asociado en la hoja especificada :" & ActiveSheet.Name & ", Verifique por favor.", vbOKOnly

  Exit Sub

  End If

  ActiveSheet.Copy

  Set Destwb = ActiveWorkbook

  TempFilePath = Environ$("temp") & "\"

  TempFileName = "Autorizaciones RC del Día - " & ActiveSheet.Name

  With Destwb

  .SaveAs TempFilePath & TempFileName & ".xls", FileFormat:=-4143

  .SendMail strTo, StrAsunto & ActiveSheet.Name

  'Set OutApp = New Outlook.Application

  'Set OutMail = OutApp.CreateItem(olMailItem)

  'With OutMail

  '  .Recipients.Add (strTo)

  '  .Subject = StrAsunto & ActiveSheet.Name & " Fecha :" & strdate

  '  .Body = StrMsg & vbCrLf & vbCrLf & vbCrLf & vbCrLf & StrFirma1 & vbCrLf & StrFirma2

  '  .Attachments.Add Destwb.FullName

  '  .Send

  'End With

  .Close

  Set OutMail = Nothing

  Set OutApp = Nothing

  End With

  Kill TempFilePath & TempFileName & ".xls"

  With Application

  .ScreenUpdating = True

  .EnableEvents = True

  End With

1:

Next

Exit Sub

ControlError:

  MsgBox "Se a detectado un error :" + Err.Number, vbCritical

End Sub[/CODE]

[vicpower]

Gracias por la respuesta!! Sabes que ahora no me corre la Macro, sabes que puede ser??

[4c7569735f50]

?? queee.. bueno lo que modifique fue esto

If Sheets(nHojas).Range("d2") = 0 Then GoTo 1[/CODE]

es decir verificar tu condición de que en la celda D2 sea o no = 0 de cada hoja que revisa el bucle exista , si se cumple la condición es decir es cero no ejecuta las acciones contenidas en el bucle.

[vicpower]

?? queee.. bueno lo que modifique fue esto

If Sheets(nHojas).Range("d2") = 0 Then GoTo 1[/CODE]

es decir verificar tu condición de que en la celda D2 sea o no = 0 de cada hoja que revisa el bucle exista , si se cumple la condición es decir es cero no ejecuta las acciones contenidas en el bucle.

Aummm no soy muy experto en Macros como te habras dado cuenta...lo que necesito es que si la Celda D2=0 no la mande por mail, si D2>0 que si la mande por mail...se entiende mas o menos?

Mil mil gracias por la ayuda!

[4c7569735f50]

Cambia de posición la línea que te comente debe quedar asi

Worksheets(nHojas).Activate

If Sheets(nHojas).Range("d2") = 0 Then GoTo 1

[/CODE]

[vicpower]

Gracias [uSER=187155]@4c7569735f50[/uSER]

El "GoTo 1" es para que vaya a la hoja siguiente? porque la Macro me da error en esa parte...Mil gracias nuevamente!