Giúp File Đọc Số ra Âm thanh dùng trong Khu Cách Ly COVID-19

Liên hệ QC

hunglam123

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
31/3/20
Bài viết
180
Được thích
43
Em xin chào cả nhà. Hiện tại bên công ty đã đều em đến 1 trung tâm quản lý các bệnh nhân cách ly tại Quận 9 ( Em làm bên nghành y tế ) . hằng ngày cứ 3 lần em đều thấy mấy anh Quân Nhân phải đọc số để Đo nhiệt độ và phát cơm mổi ngày. Nên em nghỉ ra ý tưởng lập 1 file excel để khi nhập số vào nhấn nút đọc thì âm thanh từ máy tính sẽ phát ra Loa bên ngoài. để mọi người như đều nghe thấy
Giao diện như thế này


Vùng B4:B15 là vùng lấy đường dẫn File âm thanh. Tức nhiên em đã thu âm các số 0,1,2,3..9 và câu mở đầu và câu kết thúc
Tại ô F4 em muốn nhập số bệnh nhân vào
Tại ô G4 em nhập số lần lặp lại
Nhấn nút Đọc số thì chương trình đọc ra âm thanh.
Ví dụ gõ số 0123 thì Loa phát ra " Xin mời quý khách mang số . không Một Hai Ba . Vui lòng đến quầy "

Do kiến thức em hạn hẹp em chỉ tạo mỗi được giao diện , và em đã thu âm và đã đổi sang đươi WAV hết, và các câu lệnh lấy đường dẫn âm thanh. Phần đọc số em chưa biết dùng câu lệnh gì.
rất mong mọi người cùng cac bang Quản Trị Viên giúp đở để chương trình đưa ra hoạt động giúp đở cộng đồng vướt qua mùa dịch này. Một lần nữa em xin chân thành cảm ơn
 
Lần chỉnh sửa cuối:
Báo Thanh Niên:
Lúc 9 giờ sáng nay 3 tháng tư, Khoa truyền nhiễm, Bệnh viện đa khoa Bình Thuận đã làm thủ tục công bố khỏi bệnh cho 7 bệnh nhân nhiễm Cô vít 19 và chuyển những bệnh nhân này đi cách ly tiếp 14 ngày tại Trung tâm điều trị bệnh nhân Cô vít 19 của tỉnh.
Tôi test trên FPT API với kết quả như sau:

 
Upvote 0
Bạn đừng có xóa dữ liệu ở cột G
Đã thử không đọc được anh ạ
Bài đã được tự động gộp:

Tôi trả lời cho một chủ đề cụ thể. Chỉ là đọc 1 số. Tôi không có ý định viết dài như bạn. Vì tôi đã từng viết ít ra là 3, 5 lần. Có đầy đủ các thủ tục open, play, pause, seek, close ... Người dùng chỉ phải tự viết thêm để gọi các thủ tục đó.

Nếu bạn lặp đi lặp lại là tôi "amater" thì xin chỉ rõ từng điểm để tôi học tập bạn được không? Nói miệng thì ai chả nói được.

Cái chuyện phát 1 danh sách liên tục là chuyện nhỏ như con thỏ. Tôi còn làm chuyện phát 2, 3 phim cùng lúc, phát cả phim và nhạc cùng lúc cơ. Nhưng chủ đề này người ta chỉ hỏi 1 vấn đề. Người ta hỏi và tôi đọc thấy là bạn chỉ cho vỏn vẹn 1 đoạn code dùng chrome phát audio từ google. Tôi thấy nó quá kém cỏi, vì đơn giản bạn không biết cách lấy mp3 về máy. Nếu biết thì bạn đã không dùng cách củ chuối rồi. Tôi chỉ chăm chú vào 1 việc cụ thể để cho bạn biết thôi. Tôi chỉ vạch ra một cách đi khác cho bài #8 của bạn thôi. Không viết nhiều.
Em thấy code thầy chạy rất chuẩn. Em làm được chạy được nhiều ô rồi. Giờ làm sao có Nút Stop hay Pause lại nửa là tuyệt vời.
 
Upvote 0
Hàm này chưa chuẩn anh ơi, anh xem trong file đính kèm nhé.

Chỗ tải file thì link kia trả về là tập tin audio luôn nên theo em dùng URLDownloadToFile API cho nhanh.

Vậy quy trình với TTS của Google đại khái: encode chuỗi và ghép vào link TTS, tải file audio, mở file audio.
Hàm utf8_encode sai chỗ nào hả bạn?

Tập tin đính kèm là kết quả tải về từ google? Bạn chạy tập tin đính kèm của tôi thì có tập tin ấy à? Nếu đúng thế thì cũng lạ, vì tôi chạy thì bình thường.

2 giờ đêm nên tôi quên mất URLDownloadToFile.
 
Upvote 0
Tôi test trên FPT API với kết quả như sau:
FPT Speech Synthesis API em dùng từ 2 năm rồi, code cái TTS cho smart home, và chạy được cỡ 10 ngàn ký tự vẫn mượt (API free).
Tới tháng 3/2019, Google thêm giọng đọc Việt, nâng cấp API nên tốt hơn hẳn API của FPT.

Giọng đọc anh ví dụ chắc phù hợp với mọi người chỗ anh, người bắc không nghe được (cái này vốn do vùng miền rồi mà).

-----------------

Hàm utf8_encode sai chỗ nào hả bạn?

Tập tin đính kèm là kết quả tải về từ google? Bạn chạy tập tin đính kèm của tôi thì có tập tin ấy à? Nếu đúng thế thì cũng lạ, vì tôi chạy thì bình thường.
Em không rõ sai chỗ nào đâu.
Em chỉ lấy file của anh về, ấn nút chạy và chép file audio được tạo ra gửi lên đó thôi.
 
Upvote 0
FPT Speech Synthesis API em dùng từ 2 năm rồi, code cái TTS cho smart home, và chạy được cỡ 10 ngàn ký tự vẫn mượt (API free).

Giọng đọc anh ví dụ chắc phù hợp với mọi người chỗ anh, người bắc không nghe được (cái này vốn do vùng miền rồi mà).

-----------------


Em không rõ sai chỗ nào đâu.
Em chỉ lấy file của anh về, ấn nút chạy và chép file audio được tạo ra gửi lên đó thôi.
Giọng thì mình có thể điều chỉnh theo vùng miền mà bạn.
 
Upvote 0
Em thấy code thầy chạy rất chuẩn. Em làm được chạy được nhiều ô rồi. Giờ làm sao có Nút Stop hay Pause lại nửa là tuyệt vời.
Tôi viết nhanh cho bạn, chưa test kỹ.
Lưu ý:
1. Các thủ tục trong module mciSendString là tổng quát, dùng cho nhiều nhu cầu trong các tập tin khác nhau. Tùy từng nhu cầu cụ thể cần phải viết code cụ thể để gọi các thủ tục từ mciSendString.

2. Cho nhu cầu của bạn thì tôi đã viết hộ bạn 3 module, để riêng cho rõ ràng, có trật tự. Code trong Module2 mục đích chỉ để soạn tập tin cần phát rồi gọi các thủ tục trong mciSendString để phát, hoặc để stop phiên phát audio. Module modTimer cần có để phát liên tiếp các tập tin. Module1 dùng để lấy dữ liệu từ google. Để riêng thành 3 module vì chức năng của chúng khác nhau.

Code chỉ là ví dụ, phát 1 lần. Nếu bạn muốn phát nhiều lần thì tự sửa code.
-----
Lưu ý.
Có lẽ tốt hơn là các bạn sửa
Mã:
strUrl = ...
thành
Mã:
strUrl = "https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=" & lang & "&q=" & TextToUTF8(text)
Sau đó xóa hàm utf8_encode và thêm code
Mã:
Function TextToUTF8(ByVal text As String) As String
'    ket qua tra ve co dang %c1%c2...%cn. c1, c2, ..., cn la cac ma o dang hex cua chuoi text o dang UTF8.
'    Noi cach khac là phai chuyen text sang dang utf8, rồi thay moi ky tu utf8 bang %<ma hex cua ky tu utf8>
  Dim data() As Byte
  Dim i As Integer
  Dim file As String
  file = Environ("temp") & "\translatetext.txt"
  With CreateObject("ADODB.Stream")
    .Charset = "utf-8"
    .Mode = 3
    .Type = 2
    .Open
    .WriteText text
    .Flush
    .Position = 0
    .Type = 1
    .SaveToFile file, 2
    .Close
    .Open
    .LoadFromFile file
    data = .Read()
    For i = 3 To UBound(data)
      TextToUTF8 = TextToUTF8 & "%" & Right("00" & Hex(data(i)), 2)
    Next
    .Close
  End With
End Function
 

File đính kèm

  • google text to speech.xlsm
    37.5 KB · Đọc: 48
Lần chỉnh sửa cuối:
Upvote 0
Em không rõ sai chỗ nào đâu.
Em chỉ lấy file của anh về, ấn nút chạy và chép file audio được tạo ra gửi lên đó thôi.
Thế thì cũng lạ. Tôi chạy trên máy tôi thì như tập tin đính kèm (lần trước quên).
Bạn có thể thử như thế này.
Sau dòng
strUrl = "https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=" & lang & "&q=" & utf8_encode(text)

thì thêm Debug.Print strUrl.

Sau khi chạy code bạn copy và dán nội dung của Immediate vào trình duyệt rồi phát MP3 trên trình duyệt xem.
 

File đính kèm

  • translate_tts.rar
    19.5 KB · Đọc: 28
Upvote 0
Đây anh ạ.
PHP:
https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=vi&q=Xin m����i quy�� kha��ch mang s���� 0255454 Vui lo��ng ������n qu����y

còn đây là em dùng hàm ENCODEURL() của Excel:
PHP:
https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=vi&q=Xin%20m%C6%A1%CC%80i%20quy%CC%81%20kha%CC%81ch%20mang%20s%C3%B4%CC%81%200255454%20Vui%20lo%CC%80ng%20%C4%91%C3%AA%CC%81n%20qu%C3%A2%CC%80y
 
Upvote 0
Tôi đã viết rõ là đơn giản nhất là dùng PlaySound. Và đổi WMA thành WAV vì PlaySound không phục vụ WMA.

Còn máy vạn năng thì là mciSendString rồi.

Về mciSendString tôi cũng đã viết hơn 7,5 năm rồi.

------------
Về bài #8 thì sao lại khởi động chrome? Thứ nhất là khởi động trình duyệt sẽ lâu, thứ 2 là không phải ai cũng dùng chrome. Tôi trước kia dùng IE, bây giờ dùng Firefox. Chưa bao giờ dùng trình duyệt nào khác.

Trong tập tin đính kèm tôi không khởi động trình duyệt nào cả.

Tôi cũng tự viết hàm utf8_encode.

google text to speech rất giỏi, nhưng nhiều khi dịch vẫn không chuẩn, nhiều khi dịch rất buồn cười. Nhưng cho nhu cầu chủ đề này hoàn toàn được.

Những ai chưa biết cách lấy tập tin mp3 của google về máy thì xem tôi "biểu diễn" trong tập tin. :D
Bác ơi cho em hỏi nếu muốn coppy thêm số từ ô B6 trở xuống đến B30 chẳng hạn thì làm sao để đọc được vậy bác.
 
Upvote 0
Đây anh ạ.
PHP:
https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=vi&q=Xin m����i quy�� kha��ch mang s���� 0255454 Vui lo��ng ������n qu����y

còn đây là em dùng hàm ENCODEURL() của Excel:
PHP:
https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=vi&q=Xin%20m%C6%A1%CC%80i%20quy%CC%81%20kha%CC%81ch%20mang%20s%C3%B4%CC%81%200255454%20Vui%20lo%CC%80ng%20%C4%91%C3%AA%CC%81n%20qu%C3%A2%CC%80y
Tôi lại không bị, chắc hệ miễn dịch hơi bị tốt. :D

Tôi có 2 phiên bản cơ. Trong code tôi cũng chú thích rõ
strUrl = "https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=" & lang & "&q=" & utf8_encode(text) ' hoăňc & TextToUTF8(text)
Nhưng quên đính kèm TextToUTF8.

Bạn sửa thành
Mã:
strUrl = "https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=" & lang & "&q=" & TextToUTF8(text)
...
Function TextToUTF8(ByVal text As String) As String
'    ket qua tra ve co dang %c1%c2...%cn. c1, c2, ..., cn la cac ma o dang hex cua chuoi text o dang UTF8.
'    Noi cach khac là phai chuyen text sang dang utf8, rồi thay moi ky tu utf8 bang %<ma hex cua ky tu utf8>
  Dim data() As Byte
  Dim i As Integer
  Dim file As String
  file = Environ("temp") & "\translatetext.txt"
  With CreateObject("ADODB.Stream")
    .Charset = "utf-8"
    .Mode = 3
    .Type = 2
    .Open
    .WriteText text
    .Flush
    .Position = 0
    .Type = 1
    .SaveToFile file, 2
    .Close
    .Open
    .LoadFromFile file
    data = .Read()
    For i = 3 To UBound(data)
      TextToUTF8 = TextToUTF8 & "%" & Right("00" & Hex(data(i)), 2)
    Next
    .Close
  End With
End Function

và test hộ tôi nhé.
 
Upvote 0
Kết quả chuẩn rồi anh.
(Chỉ có điều chuỗi kết quả dài hơn kết quả của hàm EncodeURL)

View attachment 234655
Dài là đúng rồi. Vì thực ra các ký tự trong a-z, A-Z không cần phải chuyển thành dạng %<mã của ký tự>, nhưng tôi lười xét nên cả các ký tự a-z, A-Z tôi cũng cho thành dạng %<mã của ký tự> luôn. :D
Nếu muốn ngắn thì trong vòng lặp For i = 3 To UBound(data) ta để nguyên các ký tự có mã < 128, không chuyển thành dạng %<mã của ký tự>

Tôi không dùng EncodeURL vì đơn giản là không có trong các phiên bản cũ hơn. Hoặc tôi mắt kém không nhìn thấy.
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi viết nhanh cho bạn, chưa test kỹ.
Lưu ý:
1. Các thủ tục trong module mciSendString là tổng quát, dùng cho nhiều nhu cầu trong các tập tin khác nhau. Tùy từng nhu cầu cụ thể cần phải viết code cụ thể để gọi các thủ tục từ mciSendString.

2. Cho nhu cầu của bạn thì tôi đã viết hộ bạn 3 module, để riêng cho rõ ràng, có trật tự. Code trong Module2 mục đích chỉ để soạn tập tin cần phát rồi gọi các thủ tục trong mciSendString để phát, hoặc để stop phiên phát audio. Module modTimer cần có để phát liên tiếp các tập tin. Module1 dùng để lấy dữ liệu từ google. Để riêng thành 3 module vì chức năng của chúng khác nhau.

Code chỉ là ví dụ, phát 1 lần. Nếu bạn muốn phát nhiều lần thì tự sửa code.
-----
Lưu ý.
Có lẽ tốt hơn là các bạn sửa
Mã:
strUrl = ...
thành
Mã:
strUrl = "https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=" & lang & "&q=" & TextToUTF8(text)
Sau đó xóa hàm utf8_encode và thêm code
Mã:
Function TextToUTF8(ByVal text As String) As String
'    ket qua tra ve co dang %c1%c2...%cn. c1, c2, ..., cn la cac ma o dang hex cua chuoi text o dang UTF8.
'    Noi cach khac là phai chuyen text sang dang utf8, rồi thay moi ky tu utf8 bang %<ma hex cua ky tu utf8>
  Dim data() As Byte
  Dim i As Integer
  Dim file As String
  file = Environ("temp") & "\translatetext.txt"
  With CreateObject("ADODB.Stream")
    .Charset = "utf-8"
    .Mode = 3
    .Type = 2
    .Open
    .WriteText text
    .Flush
    .Position = 0
    .Type = 1
    .SaveToFile file, 2
    .Close
    .Open
    .LoadFromFile file
    data = .Read()
    For i = 3 To UBound(data)
      TextToUTF8 = TextToUTF8 & "%" & Right("00" & Hex(data(i)), 2)
    Next
    .Close
  End With
End Function

Cảm ơn bạn, chương trình hữu ích quá.
Nếu muốn phát lại nhiều lần (số lần lặp lai như bài 13) và thêm thời gian phát tiếp tục cho các số tiếp theo thì làm thế nào vậy Bạn?
 
Upvote 0
Cảm ơn bạn, chương trình hữu ích quá.
Nếu muốn phát lại nhiều lần (số lần lặp lai như bài 13) và thêm thời gian phát tiếp tục cho các số tiếp theo thì làm thế nào vậy Bạn?


Sub test() ' doc Moi benh nahn Mang so & so & Vui long don quay
Dim k As Long, lap As Long, text As String, filename As String, m() As Byte
With Sheet1
text = .Range("A4").Value & " " & .Range("B5").Value & " " & .Range("A5").Value
lap = 20 ' Ví dụ lặp lại 20 lần
End With
m = GetAudio(text, "vi")
filename = Environ$("temp") & "/translate_tts.mp3"
Open filename For Binary As #1
Put #1, , m
Close #1
For k = 1 To lap
mciSendString "open """ & filename & """ alias " & AliasName, vbNullString, 0, 0
mciSendString "play " & AliasName & " wait", vbNullString, 0, 0
mciSendString "close " & AliasName, vbNullString, 0, 0
Application.Wait Now + TimeValue("0:00:02")
Next k
Kill filename
End Sub
 
Upvote 0
Sub test() ' doc Moi benh nahn Mang so & so & Vui long don quay
Dim k As Long, lap As Long, text As String, filename As String, m() As Byte
With Sheet1
text = .Range("A4").Value & " " & .Range("B5").Value & " " & .Range("A5").Value
lap = 20 ' Ví dụ lặp lại 20 lần
End With
m = GetAudio(text, "vi")
filename = Environ$("temp") & "/translate_tts.mp3"
Open filename For Binary As #1
Put #1, , m
Close #1
For k = 1 To lap
mciSendString "open """ & filename & """ alias " & AliasName, vbNullString, 0, 0
mciSendString "play " & AliasName & " wait", vbNullString, 0, 0
mciSendString "close " & AliasName, vbNullString, 0, 0
Application.Wait Now + TimeValue("0:00:02")
Next k
Kill filename
End Sub
Xin lỗi tôi không hiểu, bạn có thể đính kèm tập tin giúp tôi được không?
Hình như là một đoạn văn bản dài tương đương một ca khúc không phát được phải không bạn?
 
Upvote 0
Tôi viết nhanh cho bạn, chưa test kỹ.
Lưu ý:
1. Các thủ tục trong module mciSendString là tổng quát, dùng cho nhiều nhu cầu trong các tập tin khác nhau. Tùy từng nhu cầu cụ thể cần phải viết code cụ thể để gọi các thủ tục từ mciSendString.

2. Cho nhu cầu của bạn thì tôi đã viết hộ bạn 3 module, để riêng cho rõ ràng, có trật tự. Code trong Module2 mục đích chỉ để soạn tập tin cần phát rồi gọi các thủ tục trong mciSendString để phát, hoặc để stop phiên phát audio. Module modTimer cần có để phát liên tiếp các tập tin. Module1 dùng để lấy dữ liệu từ google. Để riêng thành 3 module vì chức năng của chúng khác nhau.

Code chỉ là ví dụ, phát 1 lần. Nếu bạn muốn phát nhiều lần thì tự sửa code.
-----
Lưu ý.
Có lẽ tốt hơn là các bạn sửa
Mã:
strUrl = ...
thành
Mã:
strUrl = "https://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=" & lang & "&q=" & TextToUTF8(text)
Sau đó xóa hàm utf8_encode và thêm code
Mã:
Function TextToUTF8(ByVal text As String) As String
'    ket qua tra ve co dang %c1%c2...%cn. c1, c2, ..., cn la cac ma o dang hex cua chuoi text o dang UTF8.
'    Noi cach khac là phai chuyen text sang dang utf8, rồi thay moi ky tu utf8 bang %<ma hex cua ky tu utf8>
  Dim data() As Byte
  Dim i As Integer
  Dim file As String
  file = Environ("temp") & "\translatetext.txt"
  With CreateObject("ADODB.Stream")
    .Charset = "utf-8"
    .Mode = 3
    .Type = 2
    .Open
    .WriteText text
    .Flush
    .Position = 0
    .Type = 1
    .SaveToFile file, 2
    .Close
    .Open
    .LoadFromFile file
    data = .Read()
    For i = 3 To UBound(data)
      TextToUTF8 = TextToUTF8 & "%" & Right("00" & Hex(data(i)), 2)
    Next
    .Close
  End With
End Function
Bác ơi cho em hỏi là phần lặp lại nếu muốn lặp lại 2 hoặc 3 lần thì như thế nào? Và lúc đọc số mình bấm nút STOP thì dừng lại, và bấm nút ĐỌC SỐ thì đọc lại từ đầu, vậy có cách nào khi mình bấm nút STOP thì dừng lại, và bấm nút ĐỌC SỐ thì đọc tiếp theo chỗ dừng đó được không Bác. Em xin cám ơn ạ!
 
Upvote 0
Ố ồ bác @batman1 giờ đã quá tuổi để hỗ trợ lâu dài cho một bài viết.

Nhưng bây giờ các bạn mong mỏi bác hoàn thiện Code.

Viết code này xong, lại bạn khác mong đoạn code khác. Cứ thế, thì sức đâu cho thấu.

Nghe Google Đọc thôi mà các bạn ấy mừng rỡ như vậy.

Nếu Dùng Google nhận diện giọng nói điều khiển Excel nữa chắc cảm xúc các bạn sẽ "lên 9 tầng mây".
 
Upvote 0
Ố ồ bác @batman1 giờ đã quá tuổi để hỗ trợ lâu dài cho một bài viết.
Nhưng bây giờ các bạn mong mỏi bác hoàn thiện Code.
Bạn hãy bỏ cái thói ăn nói kiểu ấy đi. Bạn có gì chưa vừa ý, cứ nói thẳng. Có hận gì, cứ nói ra. Tôi không sợ tiếp bạn.
Ai cũng có giới hạn của mình. Từ một bài đơn giản rồi mỗi người vào thêm một yêu cầu thì theo mãi sao nổi. Chuyện phải dừng sau một thời gian là đương nhiên.

Và rồi còn những yêu cầu nhưng không nói rõ. Thêm lặp lại? Nhưng tôi có hình như 3 phiên bản cho 3 yêu cầu khác nhau, biến tấu theo thời gian, theo yêu cầu. Bây giờ nói thêm lặp nhưng không nói thêm cho phiên bản nào. Vậy tôi phải bỏ công ra hỏi, thống nhất yêu cầu? Dừng là đương nhiên.

Nếu bạn còn hậm hực gì cứ nói ra. Tôi là người không sợ đấu tranh.
 
Upvote 0
Web KT
Back
Top Bottom