آوردن عکس شخص در یک سلول اکسل با استفاده از url

Collapse
X
 
  • زمان
  • نمایش
Clear All
new posts
  • karbar

    • 2011/08/20
    • 37

    آوردن عکس شخص در یک سلول اکسل با استفاده از url

    سلام
    در یک فایل اکسل در یک ستون آدرس اینترنتی عکس ها را داریم.
    می خواهیم در ستون بغلی عکس ها بیاید (با استفاده از آدرس اینترنتی عکس ها).
    ترجیحا عرض همه عکسها 60 پیکسل باشد و نسبت عرض به طول عکس دست نخورد
    با تشکر
    Last edited by karbar; 2013/12/15, 09:51.
  • karbar

    • 2011/08/20
    • 37

    #2
    با سرچ در اینترنت چند جواب پیدا کردم اما ارور میداد.
    دوستان اگر می توانند راهنمایی کنند

    کامنت

    • Nima

      • 2011/07/22
      • 385

      #3
      فایل ضمیمه رو ببینید
      فقط باید مسیر ذخیره عکس رو عوض کنید
      با این ماکرو شما عکس مر بوط به لینک رو در یک فولدر روی هارد ذخیره می کنید
      برای نمایش عکس هم یه سرچ انجام بدین یه جواب می رسید
      فایل های پیوست شده
      ************************************
      No LION's roar ruins my hut, I afraid of TERMITE's silence
      ************************************

      کامنت

      • Amir Ghasemiyan

        • 2013/09/20
        • 4476

        #4
        نوشته اصلی توسط karbar
        سلام
        در یک فایل اکسل در یک ستون آدرس اینترنتی عکس ها را داریم.
        می خواهیم در ستون بغلی عکس ها بیاید (با استفاده از آدرس اینترنتی عکس ها).
        ترجیحا عرض همه عکسها 60 پیکسل باشد و نسبت عرض به طول عکس دست نخورد
        با تشکر

        سلام دوست عزيز
        با اجازه محمد آقا

        اين كد هم ميتونه كمكتون كنه

        آدرس عكستون رو در A1 قرار بدين . براتون در سلول B1 عكستون رو درج ميكنه

        کد:
        Sub Test()
            Dim Pic As Picture
            Application.ScreenUpdating = False
            With ActiveSheet.Range("A1")
                Set Pic = .Parent.Pictures.Insert(.Value)
                With .Offset(, 1)
                    Pic.Top = .Top
                    Pic.Left = .Left
                    Pic.Height = .Height
                    Pic.Width = .Width
                End With
            End With
            Application.ScreenUpdating = True
        End Sub

        کامنت

        • ~M*E*H*D*I~

          • 2011/10/19
          • 4374

          #5
          با درود

          شما میتونید از افزونه زیر استفاده کنید

          پسورد mantis.ir
          فایل های پیوست شده

          sigpic

          کامنت

          • karbar

            • 2011/08/20
            • 37

            #6
            ضمن تشکر
            البته آدرس های من در ستون M بود بنابر این A1 را تبدیل به M1 کردم
            اما برای من خطای
            Run-time error '1004'
            Unable to get the Insert property of the Pictures Class
            میدهد
            خطا روی خط
            Set Pic = .Parent.Pictures.Insert(.Value)
            است

            کامنت

            • Nima

              • 2011/07/22
              • 385

              #7
              با سلام خدمت دوستان

              فایل زیر رو ملاحظه بفرمائید:
              فایل های پیوست شده
              ************************************
              No LION's roar ruins my hut, I afraid of TERMITE's silence
              ************************************

              کامنت

              • karbar

                • 2011/08/20
                • 37

                #8
                ضمن تشکر از شما
                فایل شما درست کار میکنه
                اما وقتی کد شما رو به اینصورت برای فایل اکسل خودم استفاده کردم
                کد:
                Option Explicit
                
                
                Private Declare Function URLDownloadToFile Lib "urlmon" _
                Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
                ByVal szURL As String, ByVal szFileName As String, _
                ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
                
                
                Dim Ret As Long
                
                
                '~~> This is where the images will be saved. Change as applicable
                Const FolderName As String = "D:\site\___1392\____sabtenam\aks-dabiran-test\"
                
                
                Sub loadpic2sheet_DL()
                    Dim ws As Worksheet
                    Dim LastRow As Long, i As Long
                    Dim strPath As String
                    Dim cell As String
                    
                    '~~> Name of the sheet which has the list
                    Set ws = Sheets("Sheet1")
                
                
                    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
                
                
                    For i = 1 To LastRow '<~~ 2 because row 1 has headers
                    
                        strPath = FolderName & ws.Range("A" & i).Value & "-ax.jpg"
                            Ret = URLDownloadToFile(0, ws.Range("L" & i).Value, strPath, 0, 0)
                
                
                        If Ret = 0 Then
                            ws.Range("N" & i).Value = "File successfully downloaded to " & strPath
                            ws.OLEObjects("Image" & i).Object.Picture = LoadPicture("strPath")
                        Else
                            ws.Range("N" & i).Value = "Unable to download the file"
                        End If
                    Next i
                End Sub
                عکس اول رو درست دانلود میکنه اما توی فایل اکسل نمیاره و روی این خط
                کد:
                ws.OLEObjects("Image" & i).Object.Picture = LoadPicture("strPath")
                خطای
                File not found
                میده.
                لطفا علتش رو بگید.

                کامنت

                • Nima

                  • 2011/07/22
                  • 385

                  #9
                  مسئله مهمی که باید مورد توجه قرار بگیره اینکه باید فرمت عکس jpg باشه و مهمتر اینکه اگه عکسها با نام مشترک باشند rewrite میشن یعنی روی عکس قبلی ذخیره میشن.
                  ************************************
                  No LION's roar ruins my hut, I afraid of TERMITE's silence
                  ************************************

                  کامنت

                  Working...