Erstellen Sie Schleife, um Zelle hinunterzugehen, dann Makrocode zu wiederholen

Question

Ich habe zZ einen Code, der das Excel Blatt in einem PDF speichert, das auf Information spezifisch zum Text in Zelle B2 basiert, und hängt dann die PDF in eine eMail an und email an die bestimmter Benutzer.

Ich bin mir nicht sicher, wie man einen Makro zum aktuellen Code hinzufügt, damit die Zelle in B2 die Datenüberprüfungsliste inbetet und dann das Makro wiederholt, um der nächsten Person die für sie spezifische E-Mail zu senden.

Dies ist der aktuelle Code, den ich habe pdf zu speichern und dann E-Mail:

Sub AttachActiveSheetPDF() 
Dim IsCreated As Boolean 
Dim i As Long 
Dim PdfFile As String, Title As String 
Dim OutlApp As Object 


Title = Range("A1") 

PdfFile = ActiveWorkbook.FullName 
i = InStrRev(PdfFile, ".") 
If i > 1 Then PdfFile = Left(PdfFile, i - 1) 
PdfFile = Range("G5") & "_" & ActiveSheet.Name & ".pdf" 

With ActiveSheet 
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 
End With 

On Error Resume Next 
Set OutlApp = GetObject(, "Outlook.Application") 
If Err Then 
Set OutlApp = CreateObject("Outlook.Application") 
IsCreated = True 
End If 
OutlApp.Visible = True 
On Error GoTo 0 

With OutlApp.CreateItem(0) 

.Subject = Title 
.To = Range("B4") 
.CC = Range("G3") 
.Body = "Hello " & Range("G5") & "," & vbLf & vbLf _ 
& "Your Summary is attached. If you have any further questions about your selections, please call 1-800-XXX-XXXX." & vbLf & vbLf _ 
& "Best Regards," & vbLf _ 
& Application.UserName & vbLf _ 
& "Implementation Specialist" & vbLf & vbLf 
.Attachments.Add PdfFile 

On Error Resume Next 
.Send 
Application.Visible = True 
If Err Then 
MsgBox "E-mail was not sent", vbExclamation 
Else 
MsgBox "E-mail successfully sent", vbInformation 
End If 
On Error GoTo 0 

End With 

' Delete PDF file 
Kill PdfFile 

' Quit Outlook if it was created by this code 
If IsCreated Then OutlApp.Quit 

' Release the memory of object variable 
Set OutlApp = Nothing 

End Sub 

Answer 1

ich ein Beispiel schnell geschrieben zu zeigen, wie die Datenüberprüfung Liste durchlaufen.

Sub Sample() 
    Dim ws As Worksheet 
    Dim acell As Range, DataValCell As Range, tmpRng As Range 
    Dim s As String 
    Dim MyAr As Variant 
    Dim i As Long 

    Set ws = Sheet1 '<~~> Change this to the relevant sheet 

    With ws 
     Set DataValCell = .Range("B2") 

     '~~> Handles =NamedRange or =$O$17:$O$18 
     If Left(DataValCell.Validation.Formula1, 1) = "=" Then 
      s = Mid(DataValCell.Validation.Formula1, 2) 
      Set tmpRng = .Range(s) 
     Else '~~> Handles aaa,bbb,ccc,ddd 
      s = DataValCell.Validation.Formula1 
     End If 

     If Not tmpRng Is Nothing Then '~~> Handles =NamedRange or =$O$17:$O$18 
      For Each acell In tmpRng.Cells 
       Debug.Print acell.Value 
       '~~> this is where you loop through the DV List 
      Next 
     Else '~~> Handles aaa,bbb,ccc,ddd 
      MyAr = Split(s, ",") 

      For i = LBound(MyAr) To UBound(MyAr) 
       Debug.Print MyAr(i) 
       '~~> this is where you loop through the DV List 
      Next i 
     End If 
    End With 
End Sub