open شدن خودکار فایل

Collapse
این تاپیک قفل است.
X
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • kazem1359

    • 2018/06/08
    • 331
    • 39.00

    [حل شده] open شدن خودکار فایل

    با سلام خدمت اساتید محترم
    در کد زیر در مرحله اخر که بارنگ قرمز مشخص شده عکسی با پسوند jpg روی دستکتاپ ذخیره میشه حالا می خواهم اون تصویر بعد از ذخیره شدن به صورت خودکار باز بشه و برای کاربر نمایش داده بشه. ممنون


    کد:
    Private Sub CommandButton8_Click()
    CommandButton9.Enabled = True
    On Error Resume Next
    
     With Worksheets("print3")
        .Select
        .Range("A1:k5").Clear
    End With
    count = count + 5
    If count > rrow + 6 Then
        MsgBox "داده اي براي نمايش وجود ندارد"
        Exit Sub
    End If
    'On Error Resume Next
    With Worksheets("print2")
        .Range(.Cells((count) - 4, 1), .Cells((count), 11)).Copy Destination:=Worksheets("print3").Range("A1")
        For c = 1 To 11
            Worksheets("print3").Columns(c).ColumnWidth = .Columns(c).ColumnWidth
        Next c
    End With
    If Sheets("print3").Range("a1") <> Empty Then
    
      Sheets("etelaat").Select
        Range("k2:q2").Select
        Selection.Copy
        Sheets("print3").Select
        Range("M1").Select
        ActiveSheet.Paste
        
    Application.ScreenUpdating = False
        For sht = 2 To Sheets.count
            If Sheets("print3").Range("n1") = Sheets(sht).Name Then
                For i = 1 To 7
                     Sheets(sht).Cells(1, i + 16) = Sheets("print3").Cells(1, i + 12)
                Next i
                For i = 1 To 11
                     Sheets(sht).Cells(3, i + 16) = Sheets("print3").Cells(1, i)
                Next i
                For i = 1 To 11
                     Sheets(sht).Cells(4, i + 16) = Sheets("print3").Cells(2, i)
                Next i
                For i = 1 To 11
                     Sheets(sht).Cells(5, i + 16) = Sheets("print3").Cells(3, i)
                Next i
                For i = 1 To 11
                     Sheets(sht).Cells(6, i + 16) = Sheets("print3").Cells(4, i)
                Next i
                For i = 1 To 11
                     Sheets(sht).Cells(7, i + 16) = Sheets("print3").Cells(5, i)
                Next i
    
            End If
        Next sht
    Dim shp As Shape
    sPath = Environ("USERPROFILE") & "\Desktop\test"
    Folder = Dir(sPath, vbDirectory)
    If Folder = vbNullString Then
        MkDir (sPath)
    End If
    strImageName = "test"
    [SIZE=2]Sheets(Sheet6.Range("n1").Value).Activate
    
    Set shp = ActiveSheet.Shapes("Group 48")[/SIZE]
    shp.Select
    Application.Selection.CopyPicture
    Set oDia = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)
    Set oChartArea = oDia.Chart
    oDia.Activate
    With oChartArea
        .ChartArea.Select
        .Paste
    [COLOR=#ff0000][SIZE=4]    .Export (sPath & "\" & strImageName & ".jpg")[/SIZE][/COLOR]
    End With
    oDia.Delete
        
           End If
    End Sub
  • پیمان طهماسبی

    • 2020/04/17
    • 93
    • 54.00

    #2
    لینک زیر را مشاهده بفرمایید
    قرار دادن عکس از یک آدرس در اکسل

    کامنت

    • kazem1359

      • 2018/06/08
      • 331
      • 39.00

      #3
      سلام لینک داده شده باز نشد در ضمن منظور بنده قراردادن عکس از یک ادرس به اکسل نیست منظورم اینه که یک عکس از اکسل با اجرای ماکرو در کامپیوتر ذخیره میشه حالا می خوام ضمن ذخیره عکس نیز همان لحظه باز بشه و برای کاربر نمایش داده بشه .
      (مثل فایلی که در اکسل تبدیل به pdf بشه و همان لحظه همان فایل pdf باز میشه)
      ممنون لطفا راهنمایی و کمک کنید.

      کامنت

      • kazem1359

        • 2018/06/08
        • 331
        • 39.00

        #4
        سلام
        بنده این کد را پیدا کردم که فایل ذخیره شده را فراخوانی میکنه
        Call Shell("explorer.exe" & " " & "C:\Users\RG\Desktop\form.vagozari\form.vagozari.jpg", vbNormalFocus)
        این کد روی سیستم خودم خوبه ولی روی سیستم دیگه کار نمیکنه چون قسمت قرمزرنگ در سیستمهای دیگه متفاوت هست چطور میشه این قسمت قرمزرنگ را طوری کد داد که روی کامپیوترهای دیگه کار کنه . ممنون

        کامنت

        • M_ExceL

          • 2018/04/23
          • 677

          #5
          با سلام،
          کد زیر را امتحان کنید :
          کد:
          Sub test()
          
          
          Dim sFile As String
          
          sFile = "D:\pictures\test.jpg"
          
          Shell "RunDLL32.exe C:\Windows\System32\Shimgvw.dll,ImageView_Fullscreen " & sFile
          
          End Sub
          [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
          [/CENTER]

          کامنت

          • kazem1359

            • 2018/06/08
            • 331
            • 39.00

            #6
            سلام ممنون ولی این کد برای سیستم 32 هست و روی سیستم 64 جواب نمیده و دیگه اینکه ادرس داده شده در کد ثابت هست در صورتی که در کد من ادرس در سیستم دیگه متغیر میشه.

            کامنت

            • M_ExceL

              • 2018/04/23
              • 677

              #7
              نوشته اصلی توسط kazem1359
              سلام ممنون ولی این کد برای سیستم 32 هست و روی سیستم 64 جواب نمیده و دیگه اینکه ادرس داده شده در کد ثابت هست در صورتی که در کد من ادرس در سیستم دیگه متغیر میشه.
              کد روی ویندوز ده و هفت 64 تست شده و بدون مشکل اجرا میشه.
              شما می بایست آدرس ها را بنابر نیاز خودتون داخل کدتون تعریف کنید.
              برای تشخیص درایو سیستم از تابع Environ به صورت زیر می تونید کمک بگیرید :
              کد:
              Environ("SystemDrive")
              [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
              [/CENTER]

              کامنت

              • kazem1359

                • 2018/06/08
                • 331
                • 39.00

                #8
                سلام ممنون مشکل برطرف شد

                کامنت

                چند لحظه..