Nhờ Giúp Chuyển đổi hình khi insert thành tên của bức hình ! (6 người xem)

tuantu315 · 1/7/16

Như tiêu đề em muốn tạo 1 file gồm 2 nút . 1 nút để insert ảnh vào , 1 nút để tự chuyển đổi bức hình đó thành tên của nó và đưa xuống dưới cell . Mong các anh chị diễn đàn giúp em , vì em cũng tự mài mò ko biết hỏi ai hêt. Cám ơn anh chị nhiều

tuantu315 · 1/7/16

Thực sự em đang rất cần sự giúp đỡ . Xin các bro giúp đỡ .

chucuoi92 · 1/7/16

tuantu315 đã viết:
Thực sự em đang rất cần sự giúp đỡ . Xin các bro giúp đỡ .

Bạn sửa lại code cũ một chút là được

PHP:

Sub test()
    Dim imgFilter As String, fileName As Variant, imgH As Double, imgW As Double, posX As Double, posY As Double
    Dim cellH As Double, cellW As Double, gap As Double, ws As Worksheet, i As Integer, j As Integer
    Dim Pic As Shape
    Set ws = ActiveSheet
    On Error Resume Next
    cellH = ws.[O5]
    cellW = ws.[O6]
    ws.Columns.ColumnWidth = cellW
    ws.Rows.RowHeight = cellH
    imgH = cellH * ws.[O1]
    posX = ws.Cells(1, ws.[O3]).Left
    posY = ws.Cells(ws.[O2], 1).Top
    gap = cellH * ws.[O4]
     
    imgFilter = "Image Files(*.jpg),*.jpg," & "Image Files(*.png),*.png," & "Image Files(*.jpeg),*.jpeg," & "Image Files(*.bmp),*.bmp"
    fileName = Application.GetOpenFilename(FileFilter:=imgFilter, FilterIndex:=1, Title:="Chon anh", MultiSelect:=True)
    If Not IsArray(fileName) Then Exit Sub
     Sheet2.Range("A17:D17").Resize(100).ClearContents
     For j = 1 To 100
       For Each Pic In ActiveSheet.Shapes
            If Pic.Top = posY + (j - 1) * (imgH + gap) Then
               Pic.Delete
            End If
       Next
    Next
      For i = LBound(fileName) To UBound(fileName)
        With ws.Pictures.Insert(fileName(i))
               With .ShapeRange
                    .LockAspectRatio = msoTrue
                    .Height = imgH
                End With
                .Left = posX
                .Top = posY + (i - 1) * (imgH + gap)
        Sheet2.Range("A16").Offset(i).Value = Sheet2.TextBox1.Value
        Sheet2.Range("B16").Offset(i).Value = Sheet2.TextBox2.Value
        Sheet2.Range("C16").Offset(i).Value = Dir(fileName(i))
        End With
     
    Next i
End Sub

tuantu315 · 2/7/16

Code của bạn hay quá . Thanks bạn nhiều nhưng cho mình hỏi có cách nào để lập vòng tiếp tục ko bạn ? tại vì mình thấy khi add lần thứ 2 trở đi thì nó ko nhảy dòng

chucuoi92 · 2/7/16

tuantu315 đã viết:
Code của bạn hay quá . Thanks bạn nhiều nhưng cho mình hỏi có cách nào để lập vòng tiếp tục ko bạn ? tại vì mình thấy khi add lần thứ 2 trở đi thì nó ko nhảy dòng

Ý bạn là tên và SDT ghi tiếp vào row tiếp theo ?
Mình có sửa lại code một chút, thêm nút để ghi tên và SDT từ textbox vào

tuantu315 · 3/7/16

Thanks Bạn đã giúp đỡ nhưng ý của minh là nút nhâp ảnh để chọn đường link ảnh . Nhưng khi bấm nút nhập tên sẽ chuyển dữ liệu từ textbox xuống cell. Và cứ như thế tiếp diễn . Nhưng mà theo code của bạn chỉ lấy tên được của bức ảnh add lần thứ 1 . Mình add thêm tấm thứ 2 thì tên tấm thứ nhất bị mất. Mấy bữa nay mình cũng tìm ra 1 phương án tối ưu hơn . Nhưng lại gặp 1 số trục trặc là khi không thể show hình qua sheet khác. Bạn có thể giúp mình xem mình viết code sai ở đâu ko ? file mình có 2 sheet , 1 sheet lưu lại địa chỉ bức ảnh sheet còn lại là hiển thị hình ra theo địa chỉ được lưu ở sheet đầu . Thanks ban đã nhiệt tình giúp đỡ.

chucuoi92 · 4/7/16

tuantu315 đã viết:
Thanks Bạn đã giúp đỡ nhưng ý của minh là nút nhâp ảnh để chọn đường link ảnh . Nhưng khi bấm nút nhập tên sẽ chuyển dữ liệu từ textbox xuống cell. Và cứ như thế tiếp diễn . Nhưng mà theo code của bạn chỉ lấy tên được của bức ảnh add lần thứ 1 . Mình add thêm tấm thứ 2 thì tên tấm thứ nhất bị mất. Mấy bữa nay mình cũng tìm ra 1 phương án tối ưu hơn . Nhưng lại gặp 1 số trục trặc là khi không thể show hình qua sheet khác. Bạn có thể giúp mình xem mình viết code sai ở đâu ko ? file mình có 2 sheet , 1 sheet lưu lại địa chỉ bức ảnh sheet còn lại là hiển thị hình ra theo địa chỉ được lưu ở sheet đầu . Thanks ban đã nhiệt tình giúp đỡ.

Bạn xem file đính kèm xem sửa có đúng không nhé:
Trên form khi thêm hình thì hình hiện ở sheet2 luôn
hoặc gõ tên hình ở sheet2 để tìm kiếm tên hình trên sheet1 và load vào sheet2.

tuantu315 · 4/7/16

Quá đỉnh, nhưng minh xem lại code của minh với bạn cũng giống nhau ko hiểu là sai ở đâu luôn . Vậy mà mò hoài ko ra . Thanks bạn nhiều nha !

tuantu315 · 5/7/16

chucuoi92 đã viết:
Bạn xem file đính kèm xem sửa có đúng không nhé:
Trên form khi thêm hình thì hình hiện ở sheet2 luôn
hoặc gõ tên hình ở sheet2 để tìm kiếm tên hình trên sheet1 và load vào sheet2.

Bạn làm phiền cho mình hỏi thểm 1 vấn đề nữa nha . Bây giờ mình tạo 1 textbox với 1 button ở sheet 2 . Khi nhập tên ở cột A sheet 1 vào textbox sheet2 thì picture hiển thị ra theo đúng đường dẫn ở cột b sheet1 . (Vd : ở sheet 1 , tại cột A mình lưu "hello" , Cột B "địa chỉ của hình" . Tại sheet 2 trong textbox mình nhập "hello" và nhấp button thì bức hình sẽ hiển thị theo như địa chỉ đã lưu tại cột b sheet 1. Thanks ban.

chucuoi92 · 5/7/16

tuantu315 đã viết:
Bạn làm phiền cho mình hỏi thểm 1 vấn đề nữa nha . Bây giờ mình tạo 1 textbox với 1 button ở sheet 2 . Khi nhập tên ở cột A sheet 1 vào textbox sheet2 thì picture hiển thị ra theo đúng đường dẫn ở cột b sheet1 . (Vd : ở sheet 1 , tại cột A mình lưu "hello" , Cột B "địa chỉ của hình" . Tại sheet 2 trong textbox mình nhập "hello" và nhấp button thì bức hình sẽ hiển thị theo như địa chỉ đã lưu tại cột b sheet 1. Thanks ban.

Cái này sửa đơn giản thôi mà
Bạn thay
Set vung = Sheet1.Range(Sheet1.[B1], Sheet1.[B65536].End(xlUp))
thành :
Set vung = Sheet1.Range(Sheet1.[A1], Sheet1.[A65536].End(xlUp))

và
PicName = Rng.Value
thành:
PicName = Rng.Offset(, 1).Value

sau khi thay song gõ tên bào B2 là có kết quả ngay
Còn việc thay B2 thành textbox và Worksheet_Change thành button_Click
chắc không khó chứ
Mà sao không làm ComboBox1 tự động load các tên vào và sau đó chỉ việc chọn tên-> lên hình

tuantu315 · 5/7/16

chucuoi92 đã viết:
Cái này sửa đơn giản thôi mà
Bạn thay
Set vung = Sheet1.Range(Sheet1.[B1], Sheet1.[B65536].End(xlUp))
thành :
Set vung = Sheet1.Range(Sheet1.[A1], Sheet1.[A65536].End(xlUp))

và
PicName = Rng.Value
thành:
PicName = Rng.Offset(, 1).Value

sau khi thay song gõ tên bào B2 là có kết quả ngay
Còn việc thay B2 thành textbox và Worksheet_Change thành button_Click
chắc không khó chứ

Thanks Bạn nhiều, mình làm được rồi . Vấn đề tại mình chỉ không hiểu dòng này

PicName = Rng.Value
thành:
PicName = Rng.Offset(, 1).Value

Bạn cho mình hỏi dòng này
If Not Intersect([B2], Target) Is Nothing Then
Có phải là nhập kết quả tại ô B2 HAY KO ? khi mình sữa lại thành C2 hay D2 thì nhập tên vào 2 ko ra kết quả.
Có nghĩa là bây h mình đỗi lại ô nhập. Tại mình muốn hiểu rõ về code hơn là chỉ lấy ra được kết quả .

chucuoi92 · 5/7/16

tuantu315 đã viết:
Thanks Bạn nhiều, mình làm được rồi . Vấn đề tại mình chỉ không hiểu dòng này

PicName = Rng.Value
thành:
PicName = Rng.Offset(, 1).Value

Mà sao không làm ComboBox tự động load các tên vào và sau đó chỉ việc chọn tên-> lên hình
mà lại dùng textbox với nút nhấn làm chi cho mệt

tuantu315 · 5/7/16

chucuoi92 đã viết:
Mà sao không làm ComboBox tự động load các tên vào và sau đó chỉ việc chọn tên-> lên hình
mà lại dùng textbox với nút nhấn làm chi cho mệt

hi hi tại nghiên cứu chút cho hiểu rõ hơn mai mốt biết đâu gặp phải trường hợp như vậy. Làm combo bõ thì tạo cái name vơi cái validation mình nghĩ như vậy cũng hay. Thanks bạn góp ý

Bạn cho mình hỏi dòng này
If Not Intersect([B2], Target) Is Nothing Then
Có phải là nhập kết quả tại ô B2 HAY KO ? khi mình sữa lại thành C2 hay D2 thì nhập tên vào 2 ko ra kết quả.
Có nghĩa là bây h mình đỗi lại ô nhập. Tại mình muốn hiểu rõ về code hơn là chỉ lấy ra được kết quả .

chucuoi92 · 5/7/16

tuantu315 đã viết:
hi hi tại nghiên cứu chút cho hiểu rõ hơn mai mốt biết đâu gặp phải trường hợp như vậy. Làm combo bõ thì tạo cái name vơi cái validation mình nghĩ như vậy cũng hay. Thanks bạn góp ý

Bạn cho mình hỏi dòng này
If Not Intersect([B2], Target) Is Nothing Then
Có phải là nhập kết quả tại ô B2 HAY KO ? khi mình sữa lại thành C2 hay D2 thì nhập tên vào 2 ko ra kết quả.
Có nghĩa là bây h mình đỗi lại ô nhập. Tại mình muốn hiểu rõ về code hơn là chỉ lấy ra được kết quả .

Khi bạn thay đổi và đã thấy kết quả rồi đó thôi.

tuantu315 · 5/7/16

chucuoi92 đã viết:
Khi bạn thay đổi và đã thấy kết quả rồi đó thôi.

Bạn cho mình hỏi thêm ví dụ bây h mình ko muốn nhập kết quả tại ô B2 ở sheet2 nữa mà mình muốn nhập tại ô D2 hoặc N4 thì phải làm sao . Bạn xem file sẽ hiểu ! Thanks bạn

chucuoi92 · 5/7/16

tuantu315 đã viết:
Bạn cho mình hỏi thêm ví dụ bây h mình ko muốn nhập kết quả tại ô B2 ở sheet2 nữa mà mình muốn nhập tại ô D2 hoặc N4 thì phải làm sao . Bạn xem file sẽ hiểu ! Thanks bạn

Nếu đã dùng "CommandButton1_Click()" thì không cần dòng này nữa:
"If Not Intersect([B2], Target) Is Nothing Then"

và sửa phần điều kiện find màu đỏ thành D2 hoặc N4
"Set Rng = vung.Find([D2], LookIn:=xlValues, LookAt:=xlPart)"

tuantu315 · 6/7/16

chucuoi92 đã viết:
Nếu đã dùng "CommandButton1_Click()" thì không cần dòng này nữa:
"If Not Intersect([B2], Target) Is Nothing Then"

và sửa phần điều kiện find màu đỏ thành D2 hoặc N4
"Set Rng = vung.Find([D2], LookIn:=xlValues, LookAt:=xlPart)"

Ok thanks bạn nhiều nha bây giờ mình đã thông suốt.

tuantu315 · 9/7/16

chucuoi92 đã viết:
Nếu đã dùng "CommandButton1_Click()" thì không cần dòng này nữa:
"If Not Intersect([B2], Target) Is Nothing Then"

và sửa phần điều kiện find màu đỏ thành D2 hoặc N4
"Set Rng = vung.Find([D2], LookIn:=xlValues, LookAt:=xlPart)"

bạn cho mình hỏi thêm có cách nào refesh lại listbox ko có nghĩa là khi mình insert dữ liệu mới vào thì listbox của mình ko cập nhật được phải tắt mở lại mới được . Mình dùng ListBox1.RowSource = "sheet3!artname"nhưng ko được. Thanks bạn nhiều

dhn46 · 10/7/16

tuantu315 đã viết:
bạn cho mình hỏi thêm có cách nào refesh lại listbox ko có nghĩa là khi mình insert dữ liệu mới vào thì listbox của mình ko cập nhật được phải tắt mở lại mới được . Mình dùng ListBox1.RowSource = "sheet3!artname"nhưng ko được. Thanks bạn nhiều

Bạn đã có artname?

Hãy xác định rõ artname là như thế nào sẽ có kết quả.

tuantu315 · 10/7/16

dhn46 đã viết:
Bạn đã có artname?

Hãy xác định rõ artname là như thế nào sẽ có kết quả.

Artname là tên mình đặt cho sheet khi insert dữ liệu vào . ko hiểu sao thêm code vào thì ko refesh lạilại được .

Nhờ Giúp Chuyển đổi hình khi insert thành tên của bức hình ! (6 người xem)

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

Thành viên hoạt động

File đính kèm

Thành viên hoạt động

Thành viên lười biếng

Thành viên hoạt động

Thành viên lười biếng

File đính kèm

Thành viên hoạt động

File đính kèm

Thành viên lười biếng

File đính kèm

Thành viên hoạt động

Thành viên hoạt động

Thành viên lười biếng

Thành viên hoạt động

Thành viên lười biếng

Thành viên hoạt động

Thành viên lười biếng

Thành viên hoạt động

File đính kèm

Thành viên lười biếng

Thành viên hoạt động

Thành viên hoạt động

File đính kèm

Hướng tới tương lai

Thành viên hoạt động

Đếm ngược thời gian