2024年9月8日日曜日
2024年8月18日日曜日
2024年7月31日水曜日
USB 56K アナログモデム PL-US56K Windows10 まいと～くファックス9 FAXを受信 メンテナンスレポート
太陽電業株式会社です。 R6.7の上旬にFAXが受信しずらい
状況となり、お取引先にご迷惑おかけしてしまいました。
さて、そのメンテナンスレポートです。
同様の環境で、運用中の方のお役に立てれば幸いと思いまとめました
◆運用環境
・モデム：USB 56K アナログモデム PL-US56K （2009.11ごろ発売）
・OS：Windows10
・アプリケーション：まいと～くファックス9
◆メーカサイト
・まいと～くFAX9Pro/インターコム （メーカサイト）
https://www.intercom.co.jp/mytalkfax9/
※オンラインマニュアルが見つけられませんでした...
・USB 56K アナログモデム PL-US56K ※販売終了
https://www.planex.co.jp/product/modem/pl-us56k/
・アナログモデムドライブダウンロード Windows10 ※サポート終了
https://www.planex.co.jp/support/download/usb/pl-us56k.shtml
◆FAX利用見直しは....
ところで皆様、企業または事業所単位でＦＡＸご利用ですか？
令和4年12月27日 #河野デジタル大臣 （当時）が記者会見で
「各府省の #FAX利用 見直し」をお話になって半年以上が経ちますが
弊社、FAX現役でございます。
◆エラーメッセージ まいと～くFAX
//この画面で「このモデムは使用不可です」と出ます
//設定ボタン（工具のマーク）もクリックできない
※この画面は正常作動時の画面です
◆何が調子が悪い？PCかモデムか？
結論としては、はっきりとはわかりませんでした。
ただ、状況としては
「ここに挿せば認識するが、こちらに挿すと認識しない」
PCにはいくつものUSBポートがありますゆえ....
◆推奨モデムじゃないからダメ？
推奨のモデムがいくつか挙げられていますが、
こちらの製品はその中には属しませんが、
ちゃんと受信できておりましたが...
そして、今回対応した結果受信は可能となっています。
◆モデムは壊れていないかも
・モデムテスト方法：本線ではない電話線を探してつなぐ
・まいと～くFaxで受信テスト
※ここでいう本線とは社外の方にFAX番号として
お伝えしている番号です。弊社は複数回線引いているので
このような方法が可能となりました
//FAX受信テスト
※？モデム壊れていないみたい！と、
ここでわかったんです。次のステップです。
//USBのポート差込口をあれこれ差し替えて
正解はこんな感じでした
※モデムは壊れていないと信じて、何回も挿して
何度もPCを再起動しました
◆本線につなぎましょう
//まいと～くFaxの「ダイアラ」機能を用いて
ダイアル発信テスト
※自分のスマホの電話番号を入力して「発信」クリック
ダイアル発信できています！これで「修理完了」と思いました。
◆受信テスト
※セブンイレブンのコピー機についている
FAXから会社にFAXしてみたらできました！
よかったよかった....しかしPCが新しくなれば
周辺機器であるこちらのモデムは動かないですから
買い替えを視野に考えるべきです。
◆乞うご期待
では次回はついでにおこなったPCのメンテナンスです。
タイトルは「起動時の常駐ファイル消してもいいのはどれ？」
と参ります。
今回使った製品：
・株式会社ミヨシ 「電話機コード 6極4芯/2芯 10m 」
https://item.rakuten.co.jp/mcoshop/dc-410/
・株式会社ミヨシ 「コードを延長」
https://www.mco.co.jp/products_tel/da-40/
※リンク先は類似品となります
さいごまで有難うございました。
2024年7月28日日曜日
2024年7月22日月曜日
2024年7月5日金曜日
vba ワークシートの名前を配列から命名する 配列は別ファイル（ここでは名簿.csv）から作成する
//十分なエラーテストは実施していません ご参考程度に
Sub makeP_Worksheet()
Dim targetFileName, targetFileName2, myPath, mePath As String
Dim flag As Boolean
Dim mySheetName(), LastRow As Variant
Dim cnt, i, FirstRow, myCnt As Long
Dim myRange, myObj, myFind As Range
Dim wb, wb2, myPeople As String
Dim myWb As Workbook
Dim myWbCnt As Long
On Error Resume Next
Dim bk As Workbook
For Each bk In Workbooks
If Not (bk Is ThisWorkbook) Then
bk.Close SaveChanges:=False
End If
Next
myPath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1)
mePath = ThisWorkbook.Path
targetFileName = mePath & "\" & "集計.xlsx"
targetFileName2 = myPath & "\" & "名簿.csv"
Set wb = Workbooks.Open(targetFileName)
myWbCnt = wb.Worksheets.Count
Set wb2 = Workbooks.Open(targetFileName2)
LastRow = wb2.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
If myWbCnt < LastRow Then
wb.Worksheets.Add After:=Worksheets(1), Count:=LastRow
End If
Set myRange = Range(Cells(1, 1), Cells(LastRow, 1))
Set myObj = myRange.Find(What:="*", SearchOrder:=xlByRows)
If myObj Is Nothing Then
Exit Sub
End If
wb.Worksheet(2).Name = myObj
' Debug.Print myObj & wb.Name
' Debug.Print myObj
FirstRow = myObj
' Debug.Print FirstRow
Set myFind = myObj
ReDim mySheetName(LastRow)
mySheetName(0) = myObj
wb.Worksheets(2).Name = mySheetName(0)
i = 1
Do
'// 次を検索
Set myFind = myRange.FindNext(After:=myFind)
mySheetName(i) = myFind
' Debug.Print myFind(i)
wb.Worksheets(2 + i).Name = mySheetName(i)
'// 検索不一致時はループを抜ける
If myFind Is Nothing Then
Exit Do
End If
'// 最初に検索されたセルが再検索された場合
If myFind.Address = myObj.Address Then
Exit Do
End If
' Debug.Print myFind
' mySheetName(i) = myFind
Debug.Print mySheetName(i)
i = i + 1
Loop
End Sub
2024年7月3日水曜日
改め VBAで ユーザーフォームのコンボボックスで選んだファイルを開き（ひな形） これをコピーして新しいファイルを作り コンボボックスの値と名簿.csvから検索した氏名などで名前を付けて保存し 名前がかぶったら（ｎ）として保存
//不要な箇所は全部消しました
Private Sub CommandButton2_Click()
'請求書の作成
Dim myPath, mySubPath, YearFolder As String
Dim FileName, ListBox1 As String
Dim bk As Workbook
Dim myDay As String
Dim wbNew As String
'On Error Resume Next
'自身以外のworkbooksを閉じる
For Each bk In Workbooks
If Not (bk Is ThisWorkbook) Then
bk.Close savechanges:=False
End If
Next
myPath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1) & "\" '親パスのフルパス
'myPath = ThisWorkbook.Path & "\" '自分自身のフルパス
mySubPath = myPath & "請求書-ひな形" & "\"
FileName = UserForm1.ComboBox3 & ".xls"
If UserForm1.ComboBox3 = "" Then
MsgBox "様式を選択してください"
Exit Sub
Else
Workbooks.Open mySubPath & FileName
ActiveWindow.SelectedSheets.Copy
wbNew = ActiveWorkbook.Name
End If
Dim flag As Boolean
flag = False
Dim trgtFileName As String
trgtFileName = myPath & "\" & "名簿-外注費.csv"
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name = trgtFileName Then
flg = True
Exit For
End If
Next
If flg = False Then
Workbooks.Open trgtFileName
End If
Set wb = Nothing
Dim myDayStr, ggg, e, mm, dd As String
Dim myDayLng As Long
myDay = Format(Date, "gggemmdd")
myDayStr = CStr(myDay)
ggg = StrConv(Left(myDay, 2), vbWide)
e = StrConv(Mid(myDay, 3, 1), vbWide)
mm = StrConv(UserForm1.ComboBox2.Value, vbWide)
dd = StrConv(UserForm1.ComboBox4.Value, vbWide)
invoiceday = ggg & " " & e & "年" & " " & mm & "月" & " " & dd & "日"
Dim LastRow As Integer
Dim MyRange As Range
Dim FirstCell As Range
Dim Str As String
Dim myFind, SavePath, SaveName As String
LastRow = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
SavePath = myPath & "2024-Excel" & "\" & UserForm1.ComboBox2.Value & "月"
SaveName = Format(Date, "yyyy") & "年 " & UserForm1.ComboBox2.Value & "月 " & "請求書 "
myFind = UserForm1.ComboBox3.Value
Set MyRange = ActiveWorkbook.Worksheets(1).Range(Cells(1, 5), Cells(LastRow, 8)).Find(what:=myFind, LookAt:=xlPart)
If MyRange Is Nothing Then
Debug.Print "みつかりません"
Exit Sub
Else
Set FirstCell = MyRange
End If
Dim TargetFiles As Files
SaveNameP = myPath & Format(Date, "yyyy") & "-Excel" & "\" & UserForm1.ComboBox2.Value & "月"
Set FSO = New FileSystemObject
Set TargetFiles = FSO.GetFolder(SaveNameP).Files
Dim fileSaveName As Variant
Dim fileSaveName_name As String
Dim fileSaveName_path As String
Dim k As Integer
Do
Peopele = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 1).Value
fileSaveName = (SaveNameP & "\" & SaveName & Left(Peopele, 2) & ".xlsx")
If Dir(fileSaveName) <> "" Then
fileSaveName_name = Dir(fileSaveName)
fileSaveName_path = Replace(fileSaveName, fileSaveName_name, "")
k = 1
Do While Dir(fileSaveName) <> ""
fileSaveName = fileSaveName_path & Replace(fileSaveName_name, ".xlsx", "") & "(" & k & ")" & ".xlsx"
k = k + 1
Loop
End If
Workbooks(3).Activate 'ひな形のコピーを作る
With ActiveWorkbook.Worksheets(1)
Range("N2").Value = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 4).Value 'T_no
Range("M4").Value = invoiceday
Range("O6").Value = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 2).Value 'Adress
Range("O7").Value = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 3).Value 'tel
Range("O8").Value = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 1).Value 'name
Peopele = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 1).Value
End With
Workbooks(3).SaveAs fileSaveName
Workbooks("名簿-外注費.csv").Activate
MyRange.Select
Set MyRange = Cells.FindNext(MyRange)
If FirstCell.Address = MyRange.Address Then Exit Do
Loop
For Each bk In Workbooks
If Not (bk Is ThisWorkbook) Then
bk.Close savechanges:=False
End If
Next
Set bk = Nothing
Set myPath = Nothing
Set mySubPath = Nothing
YearFolder = ""
FileName = ""
myDay = ""
wbNew = ""
myDayStr = ""
ggg = ""
e = ""
mm = ""
dd = ""
myDay = ""
myDayStr = ""
LastRow = 0
Set MyRange = Nothing
Set FirstCell = Nothing
Set myFind = Nothing
SavePath = ""
SaveName = ""
Unload Me
End Sub
登録:
投稿 (Atom)