Chuyển ảnh từ File Excel lên Form (1 người xem)

Elx Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Tôi tuân thủ nội quy khi đăng bài
Có
T

thang_nguyen1

Thành viên hoạt động
Tham gia
6/10/16
Bài viết
139
Được thích
9
Chào các bạn. Cho mình hỏi có thể dùng VBA chuyển hỉnh ảnh từ File Excel lên form được không? Mong các bạn giúp mình với. Mình xin cảm ơn!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
thang_nguyen1 đã viết:
Chào các bạn. Cho mình hỏi có thể dùng VBA chuyển hỉnh ảnh từ File Excel lên form được không? Mong các bạn giúp mình với. Mình xin cảm ơn!
Nhấp chuột vào đây để mở rộng...
Chèn đoạn code này vào Module.
Mã: 
Option Explicit
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

#If VBA7 Then
  Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As LongPtr
    hPal As LongPtr
  End Type
  Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
  Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As LongPtr
  Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
  Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As uPicDesc, _
                     RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  Private Declare PtrSafe Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As LongPtr, ByVal lpszFile As String) As LongPtr
  Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal Handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
#Else
  Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
  End Type
  Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
  Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
  Private Declare Function CloseClipboard Lib "user32" () As Long
  Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, _
                      RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
  Private Declare Function CopyImage Lib "user32" (ByVal Handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
#End If

Function PictureFromObject(ByVal Target As Object, Optional ByVal bType As Boolean = True) As IPictureDisp
  #If VBA7 Then
    Dim hPtr As LongPtr, hCopy As LongPtr
  #Else
    Dim hPtr As Long, hCopy As Long
  #End If
  Dim PicType As Long
  Const CF_BITMAP = 2
  Const CF_PALETTE = 9
  Const CF_ENHMETAFILE = 14
  Const IMAGE_BITMAP = 0
  Const LR_COPYRETURNORG = &H4
  Const PicType_BITMAP = 1
  Const PicType_ENHMETAFILE = 4
  Target.CopyPicture , IIf(bType, xlBitmap, xlPicture)
  PicType = IIf(IsClipboardFormatAvailable(CF_BITMAP) <> 0, CF_BITMAP, CF_ENHMETAFILE)
  If IsClipboardFormatAvailable(PicType) <> 0 Then
    If OpenClipboard(0) > 0 Then
      hPtr = GetClipboardData(PicType)
      If PicType = CF_BITMAP Then
        hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
      Else
        hCopy = CopyEnhMetaFile(hPtr, vbNullString)
      End If
      CloseClipboard
      If hPtr <> 0 Then
      Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPictureDisp
        With IID_IDispatch
          .Data1 = &H7BF80980
          .Data2 = &HBF32
          .Data3 = &H101A
          .Data4(0) = &H8B
          .Data4(1) = &HBB
          .Data4(2) = &H0
          .Data4(3) = &HAA
          .Data4(4) = &H0
          .Data4(5) = &H30
          .Data4(6) = &HC
          .Data4(7) = &HAB
        End With
        With uPicInfo
          .Size = Len(uPicInfo)
          .Type = IIf(PicType = CF_BITMAP, PicType_BITMAP, PicType_ENHMETAFILE)
          .hPic = hCopy
        End With
        OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
        Set PictureFromObject = IPic
      End If
    End If
  End If
End Function
Tiếp theo thêm đoạn code này vào UserForm.
Mã: 
Private Sub UserForm_Initialize()
Image1.Picture = PictureFromObject(Sheets("sheet1").Shapes("Picture 2"))
End Sub
Việc còn lại là cho UserForm nó Show lên.
 
Upvote 0
giaiphap đã viết:
Chèn đoạn code này vào Module.
Mã: 
Option Explicit
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

#If VBA7 Then
  Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As LongPtr
    hPal As LongPtr
  End Type
  Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
  Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As LongPtr
  Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
  Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As uPicDesc, _
                     RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  Private Declare PtrSafe Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As LongPtr, ByVal lpszFile As String) As LongPtr
  Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal Handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
#Else
  Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
  End Type
  Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
  Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
  Private Declare Function CloseClipboard Lib "user32" () As Long
  Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, _
                      RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
  Private Declare Function CopyImage Lib "user32" (ByVal Handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
#End If

Function PictureFromObject(ByVal Target As Object, Optional ByVal bType As Boolean = True) As IPictureDisp
  #If VBA7 Then
    Dim hPtr As LongPtr, hCopy As LongPtr
  #Else
    Dim hPtr As Long, hCopy As Long
  #End If
  Dim PicType As Long
  Const CF_BITMAP = 2
  Const CF_PALETTE = 9
  Const CF_ENHMETAFILE = 14
  Const IMAGE_BITMAP = 0
  Const LR_COPYRETURNORG = &H4
  Const PicType_BITMAP = 1
  Const PicType_ENHMETAFILE = 4
  Target.CopyPicture , IIf(bType, xlBitmap, xlPicture)
  PicType = IIf(IsClipboardFormatAvailable(CF_BITMAP) <> 0, CF_BITMAP, CF_ENHMETAFILE)
  If IsClipboardFormatAvailable(PicType) <> 0 Then
    If OpenClipboard(0) > 0 Then
      hPtr = GetClipboardData(PicType)
      If PicType = CF_BITMAP Then
        hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
      Else
        hCopy = CopyEnhMetaFile(hPtr, vbNullString)
      End If
      CloseClipboard
      If hPtr <> 0 Then
      Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPictureDisp
        With IID_IDispatch
          .Data1 = &H7BF80980
          .Data2 = &HBF32
          .Data3 = &H101A
          .Data4(0) = &H8B
          .Data4(1) = &HBB
          .Data4(2) = &H0
          .Data4(3) = &HAA
          .Data4(4) = &H0
          .Data4(5) = &H30
          .Data4(6) = &HC
          .Data4(7) = &HAB
        End With
        With uPicInfo
          .Size = Len(uPicInfo)
          .Type = IIf(PicType = CF_BITMAP, PicType_BITMAP, PicType_ENHMETAFILE)
          .hPic = hCopy
        End With
        OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
        Set PictureFromObject = IPic
      End If
    End If
  End If
End Function
Tiếp theo thêm đoạn code này vào UserForm.
Mã: 
Private Sub UserForm_Initialize()
Image1.Picture = PictureFromObject(Sheets("sheet1").Shapes("Picture 2"))
End Sub
Việc còn lại là cho UserForm nó Show lên.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn. Cho mình hỏi thêm nếu mà nhiều ảnh khác nhau thì có show được lên không ạ?
 
Upvote 0
thang_nguyen1 đã viết:
Cảm ơn bạn. Cho mình hỏi thêm nếu mà nhiều ảnh khác nhau thì có show được lên không ạ?
Nhấp chuột vào đây để mở rộng...
Mình hiện đã làm được cái này rồi. Mình muốn hỏi là khi mình bấm chuột vào ảnh nào thì ảnh trên form hiện theo ảnh mình bấm chuột không? Có giải pháp nào cho vấn đề này không?
 

File đính kèm

Upvote 0

File đính kèm

Upvote 0
thang_nguyen1 đã viết:
Cho mình hỏi là có cách nào tên "Picture" trên Textbox nó nhảy luôn theo hình ảnh mà ko dùng combobox được không?
Nhấp chuột vào đây để mở rộng...
Ý bạn là xoá nó đi luôn như này ạ?
Soumj.gif
 

File đính kèm

Upvote 0
thang_nguyen1 đã viết:
Ý mình là click vào "picture 1" hiện form. Rồi kích "picture 2" ở sheet thì form nó load theo hình "picture 2 " luôn. Nhưng điều này chắc hơi khó
Nhấp chuột vào đây để mở rộng...
là như này đúng không ạ?
Souy2.gif


Bạn có thể tham khảo việc thêm code sau ạ!
Mã: 
Sub ClickMe()
    Unload PicFrm

    PicFrm.Show False
End Sub
 
Upvote 0
thang_nguyen1 đã viết:
Rất cảm ơn bạn. Mình muốn làm cái add-in thì có được không nhỉ. Vì đây đưa macro trực tiếp vào ảnh
Nhấp chuột vào đây để mở rộng...
Hoàn toàn làm được việc tạo Add-Ins, nhưng sẽ có nhiều vấn đề phức tạp phát sinh. Việc cơ bản là vẫn phải gắn Assign Macro cho Shape, việc này vẫn tự động được, nhưng khi mang file sang máy khác sẽ bị dính lỗi không có mang Add-ins theo, vã lại khi tự động thì sẽ gây khó khăn khi có nhu cầu thay đổi kích thước hình, di chuyển hình,... Còn nhiều thức phức tạp khác.
 

File đính kèm

Upvote 0
giaiphap đã viết:
Hoàn toàn làm được việc tạo Add-Ins, nhưng sẽ có nhiều vấn đề phức tạp phát sinh. Việc cơ bản là vẫn phải gắn Assign Macro cho Shape, việc này vẫn tự động được, nhưng khi mang file sang máy khác sẽ bị dính lỗi không có mang Add-ins theo, vã lại khi tự động thì sẽ gây khó khăn khi có nhu cầu thay đổi kích thước hình, di chuyển hình,... Còn nhiều thức phức tạp khác.
Nhấp chuột vào đây để mở rộng...
Em nghĩ là khi bạn ấy tạo add-in là muốn xem popup hình trên 1 file bình thường (.xlsx) bất kỳ. Khi bật add-in thì có thêm tính năng click vào hình để xem.
Ý tưởng là:
Trong add-in Chạy một đoạn mã tự động gán OnAction = "ClickMe" cho mọi ảnh trong ActiveSheet, trong đó thì ClickMe được lấy từ trong add-in ra. Có thể là OnAction = "'" & addInName & "'!" & macroName
 
Upvote 0
hoangtuan.net đã viết:
Em nghĩ là khi bạn ấy tạo add-in là muốn xem popup hình trên 1 file bình thường (.xlsx) bất kỳ. Khi bật add-in thì có thêm tính năng click vào hình để xem.
Ý tưởng là:
Trong add-in Chạy một đoạn mã tự động gán OnAction = "ClickMe" cho mọi ảnh trong ActiveSheet, trong đó thì ClickMe được lấy từ trong add-in ra. Có thể là OnAction = "'" & addInName & "'!" & macroName
Nhấp chuột vào đây để mở rộng...
Em vừa thử cách này thì không được nó báo như hình sau ạ!
1724731888731.png
 
Upvote 0
hoangtuan.net đã viết:
Em vừa thử cách này thì không được nó báo như hình sau ạ!
View attachment 303471
Nhấp chuột vào đây để mở rộng...
Bạn viết sao thì tui không biết chứ tui viết chạy phát ngon cành đào. Còn vụ Add-Ins thì bạn nghĩ quá đơn giản, đụng thử vô đi sẽ thấy vấn đề phát sinh ngay, còn vấn đề gì thì bạn có thể thử suy nghĩ xâu hơn chút ví dụ đóng file mà không lưu, đóng file mà lưu, trên sheet có những shape trang trí, áp dụng cho file này còn file kia (đang mở) tính sao,... Thôi tui xin kết thúc vấn đề ở chủ đề này vì có lẽ cái mà chủ thớt cần đã được giải quyết, còn vụ Add-Ins là phát sinh không phù hợp với chủ đề này.
 
Upvote 0
giaiphap đã viết:
Bạn viết sao thì tui không biết chứ tui viết chạy phát ngon cành đào. Còn vụ Add-Ins thì bạn nghĩ quá đơn giản, đụng thử vô đi sẽ thấy vấn đề phát sinh ngay, còn vấn đề gì thì bạn có thể thử suy nghĩ xâu hơn chút ví dụ đóng file mà không lưu, đóng file mà lưu, trên sheet có những shape trang trí, áp dụng cho file này còn file kia (đang mở) tính sao,... Thôi tui xin kết thúc vấn đề ở chủ đề này vì có lẽ cái mà chủ thớt cần đã được giải quyết, còn vụ Add-Ins là phát sinh không phù hợp với chủ đề này.
Nhấp chuột vào đây để mở rộng...
Dạ đúng ạ. Nếu mà làm add-in thì chỉ làm theo hướng show list image trên form và mình chọn hình theo list đó thôi ạ. Cảm ơn hai bạn đã nhiệt tình giúp đỡ mình.
 
Upvote 0
giaiphap đã viết:
Bạn viết sao thì tui không biết chứ tui viết chạy phát ngon cành đào. Còn vụ Add-Ins thì bạn nghĩ quá đơn giản, đụng thử vô đi sẽ thấy vấn đề phát sinh ngay, còn vấn đề gì thì bạn có thể thử suy nghĩ xâu hơn chút ví dụ đóng file mà không lưu, đóng file mà lưu, trên sheet có những shape trang trí, áp dụng cho file này còn file kia (đang mở) tính sao,... Thôi tui xin kết thúc vấn đề ở chủ đề này vì có lẽ cái mà chủ thớt cần đã được giải quyết, còn vụ Add-Ins là phát sinh không phù hợp với chủ đề này.
Nhấp chuột vào đây để mở rộng...
Cho mình hỏi thêm làm sao để nó chạy trong được nhiều Sheet khác nhau. Như code trên thì chỉ chạy tđc trên "sheet 1"
 
Upvote 0
Xin chào các bác,
Dựa trên đề tài này, em nhờ các bác giúp em phát triển thêm như bên dưới được không?
- Có một cột B bắt đầu từ B4:B1000 sẽ gồm những hyperlink đến địa chỉ hình ảnh (có thể là ảnh online hoặc offline).
- Khi mình click chuột vào ô nào thuộc B4:B1000 thì sẽ hiện ra ảnh lên form.
- Form hiển thị ảnh sẽ tự động thay đổi kích thước dựa theo ảnh gốc (tối đa là full screen).
 

File đính kèm

Upvote 0
hoangtuan.net đã viết:
Em nghĩ là khi bạn ấy tạo add-in là muốn xem popup hình trên 1 file bình thường (.xlsx) bất kỳ. Khi bật add-in thì có thêm tính năng click vào hình để xem.
Ý tưởng là:
Trong add-in Chạy một đoạn mã tự động gán OnAction = "ClickMe" cho mọi ảnh trong ActiveSheet, trong đó thì ClickMe được lấy từ trong add-in ra. Có thể là OnAction = "'" & addInName & "'!" & macroName
Nhấp chuột vào đây để mở rộng...
Mình có giải pháp khác.
Nhúng ảnh lên userform rất dễ ( xem sản phẩm tôi đã nhúng anh của tôi vào hồ sơ xin việc...trong file Dich 6 ngôn ngữ)
Gán các nút nhấn vào Add in xong ....thì mở fie excel nào nó cũng đi theo...muốn dịch chữ nào nó dịch chữ đó...)
Bạn mở 3 file mình gửi nhé. Trong file có số ĐT zalo của mình đấy.
Ultraview lên mình trợ giúp bạn
 

File đính kèm

Upvote 0
Yêu thich VBA đã viết:
Mình có giải pháp khác.
Nhúng ảnh lên userform rất dễ ( xem sản phẩm tôi đã nhúng anh của tôi vào hồ sơ xin việc...trong file Dich 6 ngôn ngữ)
Gán các nút nhấn vào Add in xong ....thì mở fie excel nào nó cũng đi theo...muốn dịch chữ nào nó dịch chữ đó...)
Bạn mở 3 file mình gửi nhé. Trong file có số ĐT zalo của mình đấy.
Ultraview lên mình trợ giúp bạn
Nhấp chuột vào đây để mở rộng...
Dạ bác, nay em mới quay lại với diễn đàn. Để em nghiên cứu có gì không hiểu mong được bác giúp đỡ ạ!
 
Upvote 0
giaiphap đã viết:
Chèn đoạn code này vào Module.
Mã: 
Option Explicit
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

#If VBA7 Then
  Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As LongPtr
    hPal As LongPtr
  End Type
  Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
  Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As LongPtr
  Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
  Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As uPicDesc, _
                     RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  Private Declare PtrSafe Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As LongPtr, ByVal lpszFile As String) As LongPtr
  Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal Handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
#Else
  Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
  End Type
  Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
  Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
  Private Declare Function CloseClipboard Lib "user32" () As Long
  Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, _
                      RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
  Private Declare Function CopyImage Lib "user32" (ByVal Handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
#End If

Function PictureFromObject(ByVal Target As Object, Optional ByVal bType As Boolean = True) As IPictureDisp
  #If VBA7 Then
    Dim hPtr As LongPtr, hCopy As LongPtr
  #Else
    Dim hPtr As Long, hCopy As Long
  #End If
  Dim PicType As Long
  Const CF_BITMAP = 2
  Const CF_PALETTE = 9
  Const CF_ENHMETAFILE = 14
  Const IMAGE_BITMAP = 0
  Const LR_COPYRETURNORG = &H4
  Const PicType_BITMAP = 1
  Const PicType_ENHMETAFILE = 4
  Target.CopyPicture , IIf(bType, xlBitmap, xlPicture)
  PicType = IIf(IsClipboardFormatAvailable(CF_BITMAP) <> 0, CF_BITMAP, CF_ENHMETAFILE)
  If IsClipboardFormatAvailable(PicType) <> 0 Then
    If OpenClipboard(0) > 0 Then
      hPtr = GetClipboardData(PicType)
      If PicType = CF_BITMAP Then
        hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
      Else
        hCopy = CopyEnhMetaFile(hPtr, vbNullString)
      End If
      CloseClipboard
      If hPtr <> 0 Then
      Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPictureDisp
        With IID_IDispatch
          .Data1 = &H7BF80980
          .Data2 = &HBF32
          .Data3 = &H101A
          .Data4(0) = &H8B
          .Data4(1) = &HBB
          .Data4(2) = &H0
          .Data4(3) = &HAA
          .Data4(4) = &H0
          .Data4(5) = &H30
          .Data4(6) = &HC
          .Data4(7) = &HAB
        End With
        With uPicInfo
          .Size = Len(uPicInfo)
          .Type = IIf(PicType = CF_BITMAP, PicType_BITMAP, PicType_ENHMETAFILE)
          .hPic = hCopy
        End With
        OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
        Set PictureFromObject = IPic
      End If
    End If
  End If
End Function
Tiếp theo thêm đoạn code này vào UserForm.
Mã: 
Private Sub UserForm_Initialize()
Image1.Picture = PictureFromObject(Sheets("sheet1").Shapes("Picture 2"))
End Sub
Việc còn lại là cho UserForm nó Show lên.
Nhấp chuột vào đây để mở rộng...
cái này có phải áp dụng win API phải không ạ? hay làm bằng cái gì thế anh vì em thấy nhiều cú pháp lạ quá, không thấy nhiều trong vba excel
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

C
Fix lỗi Application.InputBox Type:=8 (4 người xem)
    • Cười
Trả lời
4
Đọc
44
cdshtz88
C
E
  • Question Question
VBA tự động thay đổi tham chiếu vùng (range và cell) khi insert dòng cột trong sheet tính toán
    • Cười
Trả lời
5
Đọc
107
eagle12
E
L
Hỏi lỗi excel bị tràn trang khi in
Trả lời
1
Đọc
49
Hoàng Tuấn 868
H
D
Tổng hợp dữ liệu từ các sheet sang sheet tổng
Trả lời
3
Đọc
132
dohungmo
D
T
font chu trong excel
Trả lời
2
Đọc
61
Hoàng Tuấn 868
H
khuong182018
  • Question Question
Nhờ anh chị sửa lỗi setfocus ở textbox (1 người xem)
Trả lời
9
Đọc
156
khuong182018
khuong182018
N
File chia băng tự động từ cuộn mẹ theo khổ băng và khối lượng băng cho trước
Trả lời
0
Đọc
36
nguyenanhtruong2409
N
Emyeuexcel
Tham chiếu về 1 ô-lấy ra và lọc dữ liệu
Trả lời
2
Đọc
54
bigbabol89
bigbabol89
SA_DQ
Copilot bình luận về một ván cờ vua
Trả lời
0
Đọc
66
SA_DQ
SA_DQ
T
Xin giúp đỡ lọc dữ liệu (1 người xem)
    • Cười
Trả lời
4
Đọc
106
pycckuu410
pycckuu410
Nguyễn Duy Tuân
[New] BSAC v3.0 bộ công cụ lập trình phần mềm chuyên nghiệp trong VBA
    • Thích
Trả lời
13
Đọc
4K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
  • Question Question
Code Sổ Chi Tiết Tài Khoản
Trả lời
8
Đọc
317
hieuvietmy2020
H
befaint
Chia sẻ tâm tư, xả nỗi lòng (9 người xem)
    • Thích
6 7 8
Trả lời
778
Đọc
74K
SA_DQ
SA_DQ
H
Chia sẻ file in Phiếu điều tra PCGD (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
12
Đọc
437
HUONGHCKT
H
V
Hỏi công thức để làm khối lượng trong xây dựng. Xin cảm ơn
Trả lời
11
Đọc
514
phanphu_91
P
Linhnv0001
Hỏi - Cách kiểm tra laptop là hàng lắp ráp hay không
Trả lời
3
Đọc
270
Lê Duy Thương
Lê Duy Thương
K
Nhờ anh chị làm công thức lọc dữ kiện ngày từ bảng 1 sang rút gọn ngày ở bảng 2.
Trả lời
2
Đọc
180
Lê Duy Thương
Lê Duy Thương
L
[Mẹo] Không chọn Add-in vẫn có thể sử dụng được chức năng của Add-in, giảm tốc độ loading của Excel.
    • Thích
Trả lời
2
Đọc
484
HeSanbi
HeSanbi
GPE-Trợ Lý
[GPE18] KỸ THUẬT BIỂU ĐỒ NÂNG CAO CHO DASHBOARD: TRỰC QUAN HÓA TIẾN ĐỘ THỰC HIỆN KẾ HOẠCH (1 người xem)
    • Thích
Trả lời
2
Đọc
9K
ptm0412
ptm0412
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
553
Đọc
72K
anh.nguyen287
anh.nguyen287
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom