在制作《进销存软件》进程中的积累和探索

深秋的黎明

适合自己的才是最好的！
我在开发公司《进销存管理软件》的过程中，遇到了几个难题，在论坛里请教了好几位老师，在他们的帮助下，有些棘手的问题得到了解决。
喝水不忘挖井人，饮水必须思源。所以，带着感激的心情，把一些代码分享给大家。请大家参与讨论。
代码在下面的图片里

解决的问题有：
一，如何快捷地把Excel表格截图，并复制到微信或QQ等工作群里。
二，如何一键切换打印机
三，如何导入商品编号所对应图片
四，黏贴来自于其他界面，包括微信QQ的内容五，屏幕小，看不了整体操作界面，怎么办？

YANWEI82123300

想你学习！

深秋的黎明

YANWEI82123300 发表于 2019-12-28 17:46
想你学习！

互相勉励，一起提高

深秋的黎明

把F2键设置成快捷菜单
Private Sub Workbook_Open()
Application.OnKey "{F2}", "发货单"
End Sub
以上“发货单”代码是userform2.show 0

深秋的黎明

★★★划重点啦！
在textbox窗口里实现模糊查询功能
Private Sub TextBox1_Change()
Dim i&, j%, t%, myStr$, k&, n$, P$, S$
Dim LG As Boolean, ARR1()
With Sheets("商品目录")
    Myr = .[B7000].End(3).Row
    Arrsj = .Range("A2:J" & Myr)
End With
Me.ListBox2.Clear
myStr = UCase(Me.TextBox9.Value)
For i = 1 To Len(myStr)
    If Asc(Mid$(myStr, i, 1)) < 0 Then LG = True: Exit For
Next
tr = 1
ReDim ARR1(1 To Myr, 1 To 10)
For R = 1 To UBound(Arrsj)
    For c = 1 To UBound(Arrsj, 2)
        If Arrsj(R, c) Like "*" & TextBox9 & "*" Then
            tr = tr + 1
            ARR1(tr, 1) = Arrsj(R, 1)
            ARR1(tr, 2) = Arrsj(R, 2)
            ARR1(tr, 3) = Arrsj(R, 3)
            ARR1(tr, 4) = Arrsj(R, 4)
            ARR1(tr, 5) = Arrsj(R, 5)
            ARR1(tr, 6) = Arrsj(R, 6)
            ARR1(tr, 7) = Arrsj(R, 7)
            ARR1(tr, 8) = Arrsj(R, 8)
            ARR1(tr, 9) = Arrsj(R, 9)
            ARR1(tr, 10) = Arrsj(R, 10)
        Exit For
        End If
    Next
Next
Me.ListBox2.List = ARR1
If Len(TextBox9.Value) < 5 Then   ’这里是对字节的限制
Me.ListBox3.Clear
Else
End If
End Sub

深秋的黎明

★★★一个隐形加密功能，防止文件被拷贝到其他电脑上（高手还是能秒破的）
将电脑的某序列号复制到指定单元格
For Each 序列 In GetObject("Winmgmts:").InstancesOf("Win32_Processor")
Sheet1Range("AA1").Value = CStr(序列.ProcessorId)
Next
比较两个单元格是否一致，否则退出程序
If Sheet1.Range("AA1").Value <> Sheet1.Range("AB1").Value
Then MsgBox ("软件没有注册，请联系开发！"): Exit Sub

深秋的黎明

对listbox的某列进行合算统计
For i = 0 To ListBox1.ListCount - 1
t = ListBox1.List(i, 7)
S = Val(t)
SB1 = SB1 + S
Next
TextBox3.Value = SB1

aecn

是ACCESS版的吗？想知道你这个在窗体上“打印单据”是如何实现的

深秋的黎明

aecn 发表于 2019-12-28 22:53
是ACCESS版的吗？想知道你这个在窗体上“打印单据”是如何实现的

Sheet1.Activate
If TextBox17.Text <> "当前打印机为:Fujitsu DPK1785K 在 Ne01:" Then MsgBox ("请切换打印机！"): Exit Sub
出单
A = Sheet13.Range("AB2").Value
If Application.CountIf(Sheet17.Range("C3:C200"), A) = 0 Then '避免单据号重复
直接打印
With Sheet2
i = .Range("B20000").End(3).Row
.Range("N" & i).Value = Sheet13.Range("M2").Value '发货单号
.Range("O" & i).Value = Sheet13.Range("R14").Value  '销售金额
End With
'清空表格
With Sheet17
i = .Range("B20000").End(3).Row + 1
.Range("C" & i).Value = Sheet13.Range("AA2").Value '发货单号
.Range("F" & i).Value = Sheet13.Range("R14").Value '销售金额
.Range("B" & i).Value = Sheet13.Range("R2").Value '销售日期
.Range("E" & i).Value = Sheet13.Range("AB4").Value '是否开票
.Range("D" & i).Value = Sheet13.Range("Z3").Value '单位名称
.Range("H" & i).Value = Sheet13.Range("S16").Value & Sheet13.Range("T16").Value '快递单号码
End With
Else
MsgBox "单据不能重复！", , "提示"
End If

Sub 直接打印()
ActiveWindow.SelectedSheets _
.PrintOut From:=1, To:=3, Copies:=1, Collate:=True   'Copies是打印次数
TextBox8.Value = Range("M2").Value
End Sub

Sub 出单()   ’搞了一个WAV格式的音效
Call PlaySound(ThisWorkbook.Path & "\叮.WAV", 0&, SND_FILENAME Or SND_ASYNC)
End Sub

深秋的黎明

选择打印机的界面
Application.Dialogs(xlDialogPrinterSetup).Show
TextBox1.Text = "当前打印机为:" & Application.ActivePrinter