문자열을 검색하고 열려있는 다른 워크 시트의 문자열과 일치하는 매크로가 필요합니다.

Question

주어진 조건에 따라 워크 시트에서 문자열을 검색하는 매크로를 찾고 있습니다. 그리고 다른 워크 시트의 문자열과 일치하는 그림을 해당 텍스트에 붙여 넣습니다. 문자열이 발견되지 않으면 그 문자열을 검색하고 다음 문자열을 검색해야합니다. 내가 검색 문자열을하고 그것을 PDF 파일로 변환 할 필요가있는 것처럼. 여기

는 ABC가 다음 문자열 XYZ로 검색을 이동 발견되지 않은 상기 실시 예에서의 샘플 코드

Sub EXCELTOPDF() 

    Dim strPath As String 
    Dim strFile, A As String 
    Dim NextRow As Long 

    strPath = "C:\Users\919944\desktop\xyz" 
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 
    strFile = Dir(strPath & "*.xls", vbNormal) 
Do While strFile <> "" 

Workbooks.Open strPath & strFile 




    On Error Resume Next 

If (Cells.Find(What:="ABC", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate) Then 
    ActiveCell.Value = ActiveCell.Value() 
    ActiveCell.Select 
    Windows("Image_S.xlsx").Activate 
    Cells.Find(What:="ABC", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate 
    ActiveSheet.Shapes.Range(Array("Picture 123")).Select 
    Selection.Copy 
    Windows(strFile).Activate 
    ActiveCell.Offset(0, 1).Select 
    ActiveSheet.Paste 
End If 



    If (Cells.Find(What:="XYZ", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate) Then 

    ActiveCell.Value = ActiveCell.Value() 
    ActiveCell.Select 
    Windows("Image_S.xlsx").Activate 
    Cells.Find(What:="XYZ", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate 
    ActiveSheet.Shapes.Range(Array("Picture 638")).Select 
    Selection.Copy 
    Windows(strFile).Activate 
    ActiveCell.Offset(0, 1).Select 
    ActiveSheet.Paste 
End if 




If (Cells.Find(What:="EFGH", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate) Then 
     On Error Resume Next 
    ActiveCell.Value = ActiveCell.Value() 
    ActiveCell.Select 
    Windows("Image_S.xlsx").Activate 
    Cells.Find(What:="EFGH", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate 
    ActiveSheet.Shapes.Range(Array("Picture 24")).Select 
    Selection.Copy 
    Windows(strFile).Activate 
    ActiveCell.Offset(0, 1).Select 
    ActiveSheet.Paste 
End If 



If (Cells.Find(What:="PQRS", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate) Then 
    ActiveCell.Value = ActiveCell.Value() 
    ActiveCell.Select 
    Windows("Image_S.xlsx").Activate 
    Cells.Find(What:="PQRS", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate 
    ActiveSheet.Shapes.Range(Array("Picture 23")).Select 
    Selection.Copy 
    Windows(strFile).Activate 
    ActiveCell.Offset(0, 1).Select 
    ActiveSheet.Paste 
End If 

iPtr = InStrRev(ActiveWorkbook.FullName, ".") 
If iPtr = 0 Then 
    sFileName = ActiveWorkbook.FullName & ".pdf" 
    Else 
    sFileName = Left(ActiveWorkbook.FullName, iPtr - 1) & ".pdf" 
End If 

    sFileName = Application.GetSaveAsFilename(InitialFileName:=sFileName, fileFilter:="PDF Files (*.pdf), *.pdf") 

If sFileName = "False" Then Exit Sub 

    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, filename:=sFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 
    strFile = Dir 
Loop 
End Sub 

이다. image_s는 해당 이름과 관련된 그림 목록이 들어있는 워크 시트입니다. 친절하게 필요한

Answer 1

은 컴파일하지만 테스트하지 않습니다

Sub EXCELTOPDF() 

    Dim strPath As String 
    Dim strFile, A As String 
    Dim NextRow As Long 
    Dim wb As Workbook, shtImg As Workbook 
    Dim f As Range 
    Dim arrFind, arrPic, i 

    'array of values to search for 
    arrFind = Array("ABC", "DEF", "GHI") 
    'array of corresponding shape names 
    arrPic = Array("Picture1", "Picture2", "Picture3") 

    'get a reference tothe sheet with the images 
    Set shtImg = Workbooks("Image_S.xlsx").Sheets("Images") 

    strPath = "C:\Users\919944\desktop\xyz" 
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 

    strFile = Dir(strPath & "*.xls", vbNormal) 

    Do While strFile <> "" 

     'open the workbook and get a reference to it 
     Set wb = Workbooks.Open(strPath & strFile) 

     'loop over the array of values to search for 
     For i = LBound(arrFind) To UBound(arrFind) 

      Set f = wb.Sheets(1).Find(What:=arrFind(i), After:=ActiveCell, _ 
             LookIn:=xlFormulas, LookAt:=xlPart) 

      'test to see if value was found (f will not be Nothing) 
      If Not f Is Nothing Then 
       f.Value = f.Value 
       'copy required image... 
       shtImg.Shapes(arrPic(i)).Copy 
       f.Offset(0, 1).PasteSpecial 
      End If 

     Next i 

     'your export code here.... 

     strFile = Dir() 
    Loop 

End Sub