Lỗi vỡ ảnh khi chèn ảnh vào Image trong Form Excel

Liên hệ QC
♫ђöล♥ßล†♥†µ♫

♫ђöล♥ßล†♥†µ♫

Thành viên tiêu biểu
Tham gia
10/3/18
Bài viết
684
Được thích
1,443
Giới tính
Nữ
Nghề nghiệp
Worksheet Function trong VBA , Thư viện mã lập trình, Scripting.Dictionary, Sổ tay VBA, Các hàm dò tìm và tham chiếu
Em xin Chào các Thầy(Cô); Anh(Chị) và các ạn trong diễn đàn. Chúc Thầy(Cô); Anh(Chị) và các Bạn có một ngày đầu tuần vui vẻ và hạnh phúc.
Hôm nay em có vấn đề này kính mong mọi người giúp đỡ:
Em muốn đưa ảnh vào trong khung Image của Form Excel . Mục đích là để chọn được hình vẽ sơ họa rồi chèn hình vẽ đó cho các nội dung công việc trong Biên bản kiểm tra
Hiện tại thì các công việc trên đã hoàn thành nhưng có 1 lỗi là khi ảnh được đưa vào khung Image của Form thì nó bị biến dạng không như hình vẽ ban đầu như thế này ạ (Nhiều Anh nó bị biến dạng không thể nhìn ra được hình vẽ ban đầu nữa :rolleyes:)
Hình 1 là hình ảnh
1543203411437.png
Hình 2 là hình đưa vào khung Image
1543203472118.png​
Em xin đính kèm tệp tin . Vậy em kính mong Thầy(Cô); Anh(Chị) và các Bạn khắc phục lỗi trêm dùm em với ạ.
Em xin Chân thành cám ơn -\\/.

​
 

File đính kèm

  • Insert Image.rar
    462.3 KB · Đọc: 31
Sắp xếp theo thời gian sắp xếp theo bầu chọn
batman1 đã viết:
Tôi viết ngay trong phần bạn trích mà


Bạn tải tập tin của chủ thớt rồi xem thì thấy code có trong 3 module: FunPicture, Module1, và module FrmMinhHoa (module Form)
Nhấp chuột vào đây để mở rộng...
Vâng,
batman1 đã viết:
Tôi viết ngay trong phần bạn trích mà


Bạn tải tập tin của chủ thớt rồi xem thì thấy code có trong 3 module: FunPicture, Module1, và module FrmMinhHoa (module Form)
Nhấp chuột vào đây để mở rộng...
Vâng, code trong "FrmMinhHoa" , nhưng sửa đoạn code nào thành đoạn code như thầy giúp.
Em tìm mà không thấy có đoạn code nào trong "FrmMinhHoa" mà có chứa
Mã: 
Private w As Double, h As Double
...
 
Upvote 0
quanglenb đã viết:
Vâng,

Vâng, code trong "FrmMinhHoa" , nhưng sửa đoạn code nào thành đoạn code như thầy giúp.
Em tìm mà không thấy có đoạn code nào trong "FrmMinhHoa" mà có chứa
Mã: 
Private w As Double, h As Double
...
Nhấp chuột vào đây để mở rộng...
Những gì tôi viết (khai báo biến, sub) mà trong FrmMinhHoa chưa có thì thêm vào, còn nếu đã có thì thay bằng phiên bản của tôi. Thế thôi.
 
Upvote 0
batman1 đã viết:
Những gì tôi viết (khai báo biến, sub) mà trong FrmMinhHoa chưa có thì thêm vào, còn nếu đã có thì thay bằng phiên bản của tôi. Thế thôi.
Nhấp chuột vào đây để mở rộng...
Vâng, nhưng em thêm đoạn code sau vào Form thấy báo lỗi.
Thầy xem giúp em ạ!
Mã: 
Private Sub UserForm_Initialize()
    Pth = DefinenameValue("LinkfileMH")
    If CheckDir(Pth) = True Then
        Image1.PictureSizeMode = fmPictureSizeModeStretch
        If NameExists("LinkfileMH") = True Then
            PthMyfolder = Pth
            ListBox1.List = GetFileList(PthMyfolder)
        End If
    Else
        MsgBox "Kiem tra lai duong dan file anh minh hoa"
    End If
    Image1,Autosize = TRUE
    w = Image1.width
    h = Image1.height
End Sub

Private Sub ListBox1_Click()
    With ListBox1
        If .ListCount Then
            NameImage = .List(.ListIndex)
            Image1.Picture = LoadPictureGDI(Pth & "\" & .List(.ListIndex))
            If Image1.width > w Then
                Frame4.width = Image1.width + 108
                Me.width = Image1.width + 130
            Else
                Image1.width = w
                Frame4.width = w + 108
                Me.width = w + 130
            End If
            If Image1.height > h Then
                Frame4.height = Image1.height + 60
                Me.height = Image1.height + 94
            Else
                Image1.height = h
                Frame4.height = h + 60
                Me.height = h + 94
            End If
        End If
    End With
End Sub
ab.png
 

File đính kèm

  • 11111.xlsm
    36.1 KB · Đọc: 10
Upvote 0
quanglenb đã viết:
Vâng, nhưng em thêm đoạn code sau vào Form thấy báo lỗi.
Thầy xem giúp em ạ!
Mã: 
Private Sub UserForm_Initialize()
    Pth = DefinenameValue("LinkfileMH")
    If CheckDir(Pth) = True Then
        Image1.PictureSizeMode = fmPictureSizeModeStretch
        If NameExists("LinkfileMH") = True Then
            PthMyfolder = Pth
            ListBox1.List = GetFileList(PthMyfolder)
        End If
    Else
        MsgBox "Kiem tra lai duong dan file anh minh hoa"
    End If
    Image1,Autosize = TRUE
    w = Image1.width
    h = Image1.height
End Sub

Private Sub ListBox1_Click()
    With ListBox1
        If .ListCount Then
            NameImage = .List(.ListIndex)
            Image1.Picture = LoadPictureGDI(Pth & "\" & .List(.ListIndex))
            If Image1.width > w Then
                Frame4.width = Image1.width + 108
                Me.width = Image1.width + 130
            Else
                Image1.width = w
                Frame4.width = w + 108
                Me.width = w + 130
            End If
            If Image1.height > h Then
                Frame4.height = Image1.height + 60
                Me.height = Image1.height + 94
            Else
                Image1.height = h
                Frame4.height = h + 60
                Me.height = h + 94
            End If
        End If
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Rõ ràng mình viết tiếng Việt cho người Việt đọc ...

Trích
Những gì tôi viết (khai báo biến, sub) mà trong FrmMinhHoa chưa có thì thêm vào, còn nếu đã có thì thay bằng phiên bản của tôi.
Nhấp chuột vào đây để mở rộng...

Trong bài #5 tôi có
Mã: 
Private w As Double, h As Double

Code của chủ thớt có không? Không có. Vậy thêm vào hay không thêm vào? Nếu thêm vào thì nó ở đâu, vì tôi cố tình đeo kính nhưng không tìm thấy.

Trong bài #5 tôi có
Mã: 
Private Sub UserForm_Initialize()
    ...
End Sub

Private Sub ListBox1_Click()
    ...
End Sub
Trong code của chủ thớt đã có 2 sub UserForm_Initialize và ListBox1_Click này chưa? Nếu đã có rồi thì thêm code của tôi vào hay thay code cũ bằng code của tôi? Nếu là thay thì tại sao tôi thấy có 2 sub ListBox1_Click và 2 sub UserForm_Initialize?

Tôi dừng tại đây.
 
Upvote 0
batman1 đã viết:
Rõ ràng mình viết tiếng Việt cho người Việt đọc ...

Trích


Trong bài #5 tôi có
Mã: 
Private w As Double, h As Double

Code của chủ thớt có không? Không có. Vậy thêm vào hay không thêm vào? Nếu thêm vào thì nó ở đâu, vì tôi cố tình đeo kính nhưng không tìm thấy.

Trong bài #5 tôi có
Mã: 
Private Sub UserForm_Initialize()
    ...
End Sub

Private Sub ListBox1_Click()
    ...
End Sub
Trong code của chủ thớt đã có 2 sub UserForm_Initialize và ListBox1_Click này chưa? Nếu đã có rồi thì thêm code của tôi vào hay thay code cũ bằng code của tôi? Nếu là thay thì tại sao tôi thấy có 2 sub ListBox1_Click và 2 sub UserForm_Initialize?

Tôi dừng tại đây.
Nhấp chuột vào đây để mở rộng...
Em copy code vào vị trí dòng đầu tiên
Mã: 
Private w As Double, h As Double
Và thay thế sub Private Sub UserForm_Initialize() và Sub Private Sub ListBox1_Click() bằng code của thầy.
Toàn thể code em đã thêm và thay như sau:
Mã: 
Private w As Double, h As Double
Private sArray, sArr, dArr, Pth As String
Private Sub Image4_Click()
    Call Linkfile
    PthMyfolder.Text = Pth
    ActiveWorkbook.Names.Add "LinkfileMH", Pth
Err:
End Sub
Private Sub ListBox1_Click()
    With ListBox1
        If .ListCount Then
            NameImage = .List(.ListIndex)
            Image1.Picture = LoadPictureGDI(Pth & "\" & .List(.ListIndex))
            If Image1.Width > w Then
                Frame4.Width = Image1.Width + 108
                Me.Width = Image1.Width + 130
            Else
                Image1.Width = w
                Frame4.Width = w + 108
                Me.Width = w + 130
            End If
            If Image1.Height > h Then
                Frame4.Height = Image1.Height + 60
                Me.Height = Image1.Height + 94
            Else
                Image1.Height = h
                Frame4.Height = h + 60
                Me.Height = h + 94
            End If
        End If
    End With
End Sub
Private Sub PthMyfolder_Change()
    If CheckDir(PthMyfolder) = True Then ListBox1.List = GetFileList(PthMyfolder)
End Sub
Private Sub UserForm_Initialize()
    Pth = DefinenameValue("LinkfileMH")
    If CheckDir(Pth) = True Then
        Image1.PictureSizeMode = fmPictureSizeModeStretch
        If NameExists("LinkfileMH") = True Then
            PthMyfolder = Pth
            ListBox1.List = GetFileList(PthMyfolder)
        End If
    Else
        MsgBox "Kiem tra lai duong dan file anh minh hoa"
    End If
    Image1 , AutoSize = True
    w = Image1.Width
    h = Image1.Height
End Sub
Private Sub UserForm_Terminate()
    Set dic = Nothing
End Sub
Sub Linkfile()
    On Error GoTo Err
    Application.FileDialog(msoFileDialogFolderPicker).Show
    Pth = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems.Item(1)
Err:
    Exit Sub
End Sub
Sub XoaName(SName As String)
    Dim Definename As Name
    For Each Definename In ThisWorkbook.Names
        If UCase(Definename.Name) = UCase(SName) Then Definename.Delete
    Next
End Sub
Function DefinenameValue(ByVal SName As String) As String
    Dim Definename As Name, Str As String
    For Each Definename In ThisWorkbook.Names
        If UCase(Definename.Name) = UCase(SName) Then
            Str = Replace(Definename.Value, "=", "")
            DefinenameValue = Replace(Str, """", "")
            Exit Function
        End If
    Next
    DefinenameValue = Str
End Function
Function NameExists(ByVal DFName As String) As Boolean
    On Error Resume Next
    Application.Volatile
    NameExists = CBool(Len(Names(DFName).Name))
End Function
Function CheckDir(Directory As String) As Boolean
    On Error GoTo ErrNotExist
    Call ChDir(Directory)
    CheckDir = True
    Exit Function
ErrNotExist:
    CheckDir = False
End Function
Và khi chạy Form thấy báo lỗi, nhờ thầy xem giúp em nốt vấn đề này ạ!
a2.png
 
Upvote 0
quanglenb đã viết:
Em copy code vào vị trí dòng đầu tiên
Nhấp chuột vào đây để mở rộng...
Do gõ nhầm. Dòng tô vàng phải là Image1.AutoSize = True (dấu chấm chứ không phải dấu phẩy).

Nhưng thôi. Tôi đã chỉ sửa 2 sub của chủ thớt thôi. Bây giờ xem lại thấy họ làm lằng nhằng quá. Vd. dùng Name để ghi đường dẫn tới thư mục ảnh - đường dẫn được chọn khi nhấn nút.

Tôi soạn cho bạn code khác.

Những việc phải làm:
1. Trong tập tin 11111.xlsm xóa name LinkfileMH
2. Giữ nguyên 2 module là FunPicture và Module1.
3. Loại bỏ TextBox và nút ở dòng đầu tiên của Form
4. Xóa toàn bộ code trong module FrmMinhHoa và dán code sau vào.

Mã: 
Private w As Double, h As Double

Private Sub UserForm_Initialize()
    Image1.PictureSizeMode = fmPictureSizeModeStretch
    ListBox1.List = GetFileList(ThisWorkbook.Path & "\image")
    Image1.AutoSize = True
    w = Image1.Width
    h = Image1.Height
End Sub

Private Sub ListBox1_Click()
    With ListBox1
        If .ListCount Then
            Image1.Picture = LoadPictureGDI(ThisWorkbook.Path & "\image\" & .List(.ListIndex))
            If Image1.Width > w Then
                Frame4.Width = Image1.Width + 108
                Me.Width = Image1.Width + 130
            Else
                Image1.Width = w
                Frame4.Width = w + 108
                Me.Width = w + 130
            End If
            If Image1.Height > h Then
                Frame4.Height = Image1.Height + 60
                Me.Height = Image1.Height + 94
            Else
                Image1.Height = h
                Frame4.Height = h + 60
                Me.Height = h + 94
            End If
        End If
    End With
End Sub

5. Lưu lại tập tin.

Lưu ý: Để có thể chạy code thì phải:
- có thư mục ảnh tên là image. Đặt các ảnh trong thư mục image.
- thư mục image và tập tin Excel phải ở cùng trong thư mục mẹ.
 
Upvote 0
batman1 đã viết:
Do gõ nhầm. Dòng tô vàng phải là Image1.AutoSize = True (dấu chấm chứ không phải dấu phẩy).

Nhưng thôi. Tôi đã chỉ sửa 2 sub của chủ thớt thôi. Bây giờ xem lại thấy họ làm lằng nhằng quá. Vd. dùng Name để ghi đường dẫn tới thư mục ảnh - đường dẫn được chọn khi nhấn nút.

Tôi soạn cho bạn code khác.

Những việc phải làm:
1. Trong tập tin 11111.xlsm xóa name LinkfileMH
2. Giữ nguyên 2 module là FunPicture và Module1.
3. Loại bỏ TextBox và nút ở dòng đầu tiên của Form
4. Xóa toàn bộ code trong module FrmMinhHoa và dán code sau vào.

Mã: 
Private w As Double, h As Double

Private Sub UserForm_Initialize()
    Image1.PictureSizeMode = fmPictureSizeModeStretch
    ListBox1.List = GetFileList(ThisWorkbook.Path & "\image")
    Image1.AutoSize = True
    w = Image1.Width
    h = Image1.Height
End Sub

Private Sub ListBox1_Click()
    With ListBox1
        If .ListCount Then
            Image1.Picture = LoadPictureGDI(ThisWorkbook.Path & "\image\" & .List(.ListIndex))
            If Image1.Width > w Then
                Frame4.Width = Image1.Width + 108
                Me.Width = Image1.Width + 130
            Else
                Image1.Width = w
                Frame4.Width = w + 108
                Me.Width = w + 130
            End If
            If Image1.Height > h Then
                Frame4.Height = Image1.Height + 60
                Me.Height = Image1.Height + 94
            Else
                Image1.Height = h
                Frame4.Height = h + 60
                Me.Height = h + 94
            End If
        End If
    End With
End Sub

5. Lưu lại tập tin.

Lưu ý: Để có thể chạy code thì phải:
- có thư mục ảnh tên là image. Đặt các ảnh trong thư mục image.
- thư mục image và tập tin Excel phải ở cùng trong thư mục mẹ.
Nhấp chuột vào đây để mở rộng...
Vâng, em làm được rồi.
Cảm ơn thầy đã giúp đỡ em!
 
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Em xin Chào các Thầy(Cô); Anh(Chị) và các ạn trong diễn đàn. Chúc Thầy(Cô); Anh(Chị) và các Bạn có một ngày đầu tuần vui vẻ và hạnh phúc.
Hôm nay em có vấn đề này kính mong mọi người giúp đỡ:
Em muốn đưa ảnh vào trong khung Image của Form Excel . Mục đích là để chọn được hình vẽ sơ họa rồi chèn hình vẽ đó cho các nội dung công việc trong Biên bản kiểm tra
Hiện tại thì các công việc trên đã hoàn thành nhưng có 1 lỗi là khi ảnh được đưa vào khung Image của Form thì nó bị biến dạng không như hình vẽ ban đầu như thế này ạ (Nhiều Anh nó bị biến dạng không thể nhìn ra được hình vẽ ban đầu nữa :rolleyes:)
Hình 1 là hình ảnh
View attachment 208281
Hình 2 là hình đưa vào khung Image
View attachment 208282​
Em xin đính kèm tệp tin . Vậy em kính mong Thầy(Cô); Anh(Chị) và các Bạn khắc phục lỗi trêm dùm em với ạ.
Em xin Chân thành cám ơn -\\/.

​
Nhấp chuột vào đây để mở rộng...

Không biết bạn xử lý được chưa? Việc phân giải không theo ý muốn do kích thước Image không cân xứng với Picture, dẫn tới bị co kéo. Cách xử lý như sau:
- Nên để ảnh đuôi có chất lượng tốt hơn, như bmp chẳng hạn thay vì png.
- Thiết lập thuộc tính PictureSizeMode = 0. Sau đó co kéo kích thước Image cho vừa khít. Nếu size của ảnh gốc không phù hợp (to hoặc bé quá) thì sửa file gốc nhé.

Picture in Image.jpg
 
Upvote 0
PhanTuHuong đã viết:
Không biết bạn xử lý được chưa? Việc phân giải không theo ý muốn do kích thước Image không cân xứng với Picture, dẫn tới bị co kéo. Cách xử lý như sau:
- Nên để ảnh đuôi có chất lượng tốt hơn, như bmp chẳng hạn thay vì png.
- Thiết lập thuộc tính PictureSizeMode = 0. Sau đó co kéo kích thước Image cho vừa khít. Nếu size của ảnh gốc không phù hợp (to hoặc bé quá) thì sửa file gốc nhé.

View attachment 229744
Nhấp chuột vào đây để mở rộng...
Thầy chỉnh ảnh nét, form thầy tạo chuyên nghiệp
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3 4
Trả lời
64
Đọc
945
VetMini
V
S
Sao excel lại biến dữ liệu thành dữ liệu nhiều các con số?
Trả lời
11
Đọc
112
ongke0711
ongke0711
A
  • Question
cách dùng lockxls bảo vệ file
Trả lời
18
Đọc
3K
chintn
chintn
emlat3
Đặt màu xen kẽ các dòng theo ký tự
Trả lời
6
Đọc
137
emlat3
emlat3
kyo
  • Suggestion
Bài viết: SAP Scripting – Excel và SAP (P2)
    • Thích
Trả lời
12
Đọc
8K
pic vo123
P
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom